Commit 62e19a6d authored by Travis Whitaker's avatar Travis Whitaker Committed by Ben Gamari

Correct closure observation, construction, and mutation on weak memory machines.

Here the following changes are introduced:
    - A read barrier machine op is added to Cmm.
    - The order in which a closure's fields are read and written is changed.
    - Memory barriers are added to RTS code to ensure correctness on
      out-or-order machines with weak memory ordering.

Cmm has a new CallishMachOp called MO_ReadBarrier. On weak memory machines, this
is lowered to an instruction that ensures memory reads that occur after said
instruction in program order are not performed before reads coming before said
instruction in program order. On machines with strong memory ordering properties
(e.g. X86, SPARC in TSO mode) no such instruction is necessary, so
MO_ReadBarrier is simply erased. However, such an instruction is necessary on
weakly ordered machines, e.g. ARM and PowerPC.

Weam memory ordering has consequences for how closures are observed and mutated.
For example, consider a closure that needs to be updated to an indirection. In
order for the indirection to be safe for concurrent observers to enter, said
observers must read the indirection's info table before they read the
indirectee. Furthermore, the entering observer makes assumptions about the
closure based on its info table contents, e.g. an INFO_TYPE of IND imples the
closure has an indirectee pointer that is safe to follow.

When a closure is updated with an indirection, both its info table and its
indirectee must be written. With weak memory ordering, these two writes can be
arbitrarily reordered, and perhaps even interleaved with other threads' reads
and writes (in the absence of memory barrier instructions). Consider this
example of a bad reordering:

- An updater writes to a closure's info table (INFO_TYPE is now IND).
- A concurrent observer branches upon reading the closure's INFO_TYPE as IND.
- A concurrent observer reads the closure's indirectee and enters it. (!!!)
- An updater writes the closure's indirectee.

Here the update to the indirectee comes too late and the concurrent observer has
jumped off into the abyss. Speculative execution can also cause us issues,
consider:

- An observer is about to case on a value in closure's info table.
- The observer speculatively reads one or more of closure's fields.
- An updater writes to closure's info table.
- The observer takes a branch based on the new info table value, but with the
  old closure fields!
- The updater writes to the closure's other fields, but its too late.

Because of these effects, reads and writes to a closure's info table must be
ordered carefully with respect to reads and writes to the closure's other
fields, and memory barriers must be placed to ensure that reads and writes occur
in program order. Specifically, updates to a closure must follow the following
pattern:

- Update the closure's (non-info table) fields.
- Write barrier.
- Update the closure's info table.

Observing a closure's fields must follow the following pattern:

- Read the closure's info pointer.
- Read barrier.
- Read the closure's (non-info table) fields.

This patch updates RTS code to obey this pattern. This should fix long-standing
SMP bugs on ARM (specifically newer aarch64 microarchitectures supporting
out-of-order execution) and PowerPC. This fixesd issue #15449.
parent 568d7279
...@@ -66,6 +66,7 @@ again: ...@@ -66,6 +66,7 @@ again:
// Note [Heap memory barriers] in SMP.h. // Note [Heap memory barriers] in SMP.h.
untaggedfun = UNTAG(fun); untaggedfun = UNTAG(fun);
info = %INFO_PTR(untaggedfun); info = %INFO_PTR(untaggedfun);
prim_read_barrier;
switch [INVALID_OBJECT .. N_CLOSURE_TYPES] switch [INVALID_OBJECT .. N_CLOSURE_TYPES]
(TO_W_( %INFO_TYPE(%STD_INFO(info)) )) { (TO_W_( %INFO_TYPE(%STD_INFO(info)) )) {
case case
...@@ -106,6 +107,7 @@ again: ...@@ -106,6 +107,7 @@ again:
CCS_ALLOC(BYTES_TO_WDS(SIZEOF_StgPAP), CCS_OVERHEAD); CCS_ALLOC(BYTES_TO_WDS(SIZEOF_StgPAP), CCS_OVERHEAD);
P_ pap; P_ pap;
pap = Hp - SIZEOF_StgPAP + WDS(1); pap = Hp - SIZEOF_StgPAP + WDS(1);
prim_write_barrier;
SET_HDR(pap, stg_PAP_info, CCCS); SET_HDR(pap, stg_PAP_info, CCCS);
StgPAP_arity(pap) = arity; StgPAP_arity(pap) = arity;
if (arity <= TAG_MASK) { if (arity <= TAG_MASK) {
...@@ -134,6 +136,7 @@ again: ...@@ -134,6 +136,7 @@ again:
pap = Hp - size + WDS(1); pap = Hp - size + WDS(1);
// We'll lose the original PAP, so we should enter its CCS // We'll lose the original PAP, so we should enter its CCS
ccall enterFunCCS(BaseReg "ptr", StgHeader_ccs(untaggedfun) "ptr"); ccall enterFunCCS(BaseReg "ptr", StgHeader_ccs(untaggedfun) "ptr");
prim_write_barrier;
SET_HDR(pap, stg_PAP_info, CCCS); SET_HDR(pap, stg_PAP_info, CCCS);
StgPAP_arity(pap) = StgPAP_arity(untaggedfun); StgPAP_arity(pap) = StgPAP_arity(untaggedfun);
StgPAP_n_args(pap) = StgPAP_n_args(untaggedfun); StgPAP_n_args(pap) = StgPAP_n_args(untaggedfun);
...@@ -284,6 +287,7 @@ for: ...@@ -284,6 +287,7 @@ for:
info = %GET_FUN_INFO(UNTAG(R1)); info = %GET_FUN_INFO(UNTAG(R1));
W_ type; W_ type;
type = TO_W_(StgFunInfoExtra_fun_type(info)); type = TO_W_(StgFunInfoExtra_fun_type(info));
prim_read_barrier;
if (type == ARG_GEN) { if (type == ARG_GEN) {
jump StgFunInfoExtra_slow_apply(info) [R1]; jump StgFunInfoExtra_slow_apply(info) [R1];
} }
...@@ -362,6 +366,7 @@ for: ...@@ -362,6 +366,7 @@ for:
info = %GET_FUN_INFO(UNTAG(R1)); info = %GET_FUN_INFO(UNTAG(R1));
W_ type; W_ type;
type = TO_W_(StgFunInfoExtra_fun_type(info)); type = TO_W_(StgFunInfoExtra_fun_type(info));
prim_read_barrier;
if (type == ARG_GEN) { if (type == ARG_GEN) {
jump StgFunInfoExtra_slow_apply(info) [R1]; jump StgFunInfoExtra_slow_apply(info) [R1];
} }
...@@ -426,12 +431,14 @@ for: ...@@ -426,12 +431,14 @@ for:
TICK_ENT_VIA_NODE(); TICK_ENT_VIA_NODE();
#if defined(NO_ARG_REGS) #if defined(NO_ARG_REGS)
prim_read_barrier;
jump %GET_ENTRY(UNTAG(R1)) [R1]; jump %GET_ENTRY(UNTAG(R1)) [R1];
#else #else
W_ info; W_ info;
info = %GET_FUN_INFO(UNTAG(R1)); info = %GET_FUN_INFO(UNTAG(R1));
W_ type; W_ type;
type = TO_W_(StgFunInfoExtra_fun_type(info)); type = TO_W_(StgFunInfoExtra_fun_type(info));
prim_read_barrier;
if (type == ARG_GEN) { if (type == ARG_GEN) {
jump StgFunInfoExtra_slow_apply(info) [R1]; jump StgFunInfoExtra_slow_apply(info) [R1];
} }
......
...@@ -72,6 +72,7 @@ eval: ...@@ -72,6 +72,7 @@ eval:
tag = GETTAG(p); tag = GETTAG(p);
p = UNTAG(p); p = UNTAG(p);
info = %INFO_PTR(p); info = %INFO_PTR(p);
prim_read_barrier;
type = TO_W_(%INFO_TYPE(%STD_INFO(info))); type = TO_W_(%INFO_TYPE(%STD_INFO(info)));
switch [0 .. N_CLOSURE_TYPES] type { switch [0 .. N_CLOSURE_TYPES] type {
...@@ -171,7 +172,6 @@ eval: ...@@ -171,7 +172,6 @@ eval:
cards = SIZEOF_StgMutArrPtrs + WDS(ptrs); cards = SIZEOF_StgMutArrPtrs + WDS(ptrs);
ALLOCATE(compact, BYTES_TO_WDS(size), p, to, tag); ALLOCATE(compact, BYTES_TO_WDS(size), p, to, tag);
P_[pp] = tag | to; P_[pp] = tag | to;
SET_HDR(to, StgHeader_info(p), StgHeader_ccs(p));
StgMutArrPtrs_ptrs(to) = ptrs; StgMutArrPtrs_ptrs(to) = ptrs;
StgMutArrPtrs_size(to) = StgMutArrPtrs_size(p); StgMutArrPtrs_size(to) = StgMutArrPtrs_size(p);
prim %memcpy(to + cards, p + cards , size - cards, 1); prim %memcpy(to + cards, p + cards , size - cards, 1);
...@@ -185,6 +185,7 @@ eval: ...@@ -185,6 +185,7 @@ eval:
i = i + 1; i = i + 1;
goto loop0; goto loop0;
} }
SET_HDR(to, StgHeader_info(p), StgHeader_ccs(p));
return(); return();
} }
...@@ -201,7 +202,6 @@ eval: ...@@ -201,7 +202,6 @@ eval:
ptrs = StgSmallMutArrPtrs_ptrs(p); ptrs = StgSmallMutArrPtrs_ptrs(p);
ALLOCATE(compact, BYTES_TO_WDS(SIZEOF_StgSmallMutArrPtrs) + ptrs, p, to, tag); ALLOCATE(compact, BYTES_TO_WDS(SIZEOF_StgSmallMutArrPtrs) + ptrs, p, to, tag);
P_[pp] = tag | to; P_[pp] = tag | to;
SET_HDR(to, StgHeader_info(p), StgHeader_ccs(p));
StgSmallMutArrPtrs_ptrs(to) = ptrs; StgSmallMutArrPtrs_ptrs(to) = ptrs;
i = 0; i = 0;
loop1: loop1:
...@@ -213,6 +213,7 @@ eval: ...@@ -213,6 +213,7 @@ eval:
i = i + 1; i = i + 1;
goto loop1; goto loop1;
} }
SET_HDR(to, StgHeader_info(p), StgHeader_ccs(p));
return(); return();
} }
...@@ -238,7 +239,6 @@ eval: ...@@ -238,7 +239,6 @@ eval:
ALLOCATE(compact, size, p, to, tag); ALLOCATE(compact, size, p, to, tag);
P_[pp] = tag | to; P_[pp] = tag | to;
SET_HDR(to, StgHeader_info(p), StgHeader_ccs(p));
// First, copy the non-pointers // First, copy the non-pointers
if (nptrs > 0) { if (nptrs > 0) {
...@@ -248,6 +248,7 @@ eval: ...@@ -248,6 +248,7 @@ eval:
i = i + 1; i = i + 1;
if (i < ptrs + nptrs) ( likely: True ) goto loop2; if (i < ptrs + nptrs) ( likely: True ) goto loop2;
} }
SET_HDR(to, StgHeader_info(p), StgHeader_ccs(p));
// Next, recursively compact and copy the pointers // Next, recursively compact and copy the pointers
if (ptrs == 0) { return(); } if (ptrs == 0) { return(); }
......
...@@ -249,6 +249,7 @@ StgClosure * newEmptyPAP (Capability *cap, ...@@ -249,6 +249,7 @@ StgClosure * newEmptyPAP (Capability *cap,
uint32_t arity) uint32_t arity)
{ {
StgPAP *pap = (StgPAP *)allocate(cap, sizeofW(StgPAP)); StgPAP *pap = (StgPAP *)allocate(cap, sizeofW(StgPAP));
write_barrier();
SET_HDR(pap, &stg_PAP_info, cap->r.rCCCS); SET_HDR(pap, &stg_PAP_info, cap->r.rCCCS);
pap->arity = arity; pap->arity = arity;
pap->n_args = 0; pap->n_args = 0;
...@@ -273,7 +274,7 @@ StgClosure * copyPAP (Capability *cap, StgPAP *oldpap) ...@@ -273,7 +274,7 @@ StgClosure * copyPAP (Capability *cap, StgPAP *oldpap)
for (i = 0; i < ((StgPAP *)pap)->n_args; i++) { for (i = 0; i < ((StgPAP *)pap)->n_args; i++) {
pap->payload[i] = oldpap->payload[i]; pap->payload[i] = oldpap->payload[i];
} }
// No write barrier is needed here as this is a new allocation write_barrier();
SET_HDR(pap, &stg_PAP_info, cap->r.rCCCS); SET_HDR(pap, &stg_PAP_info, cap->r.rCCCS);
return (StgClosure *)pap; return (StgClosure *)pap;
} }
...@@ -482,8 +483,9 @@ eval_obj: ...@@ -482,8 +483,9 @@ eval_obj:
{ {
StgUpdateFrame *__frame; StgUpdateFrame *__frame;
__frame = (StgUpdateFrame *)Sp; __frame = (StgUpdateFrame *)Sp;
SET_INFO((StgClosure *)__frame, (StgInfoTable *)&stg_upd_frame_info);
__frame->updatee = (StgClosure *)(ap); __frame->updatee = (StgClosure *)(ap);
write_barrier();
SET_INFO((StgClosure *)__frame, (StgInfoTable *)&stg_upd_frame_info);
} }
ENTER_CCS_THUNK(cap,ap); ENTER_CCS_THUNK(cap,ap);
...@@ -809,7 +811,7 @@ do_apply: ...@@ -809,7 +811,7 @@ do_apply:
for (i = 0; i < m; i++) { for (i = 0; i < m; i++) {
new_pap->payload[pap->n_args + i] = (StgClosure *)SpW(i); new_pap->payload[pap->n_args + i] = (StgClosure *)SpW(i);
} }
// No write barrier is needed here as this is a new allocation write_barrier();
SET_HDR(new_pap,&stg_PAP_info,cap->r.rCCCS); SET_HDR(new_pap,&stg_PAP_info,cap->r.rCCCS);
tagged_obj = (StgClosure *)new_pap; tagged_obj = (StgClosure *)new_pap;
Sp_addW(m); Sp_addW(m);
...@@ -852,7 +854,7 @@ do_apply: ...@@ -852,7 +854,7 @@ do_apply:
for (i = 0; i < m; i++) { for (i = 0; i < m; i++) {
pap->payload[i] = (StgClosure *)SpW(i); pap->payload[i] = (StgClosure *)SpW(i);
} }
// No write barrier is needed here as this is a new allocation write_barrier();
SET_HDR(pap, &stg_PAP_info,cap->r.rCCCS); SET_HDR(pap, &stg_PAP_info,cap->r.rCCCS);
tagged_obj = (StgClosure *)pap; tagged_obj = (StgClosure *)pap;
Sp_addW(m); Sp_addW(m);
...@@ -1097,7 +1099,7 @@ run_BCO: ...@@ -1097,7 +1099,7 @@ run_BCO:
new_aps->payload[i] = (StgClosure *)SpW(i-2); new_aps->payload[i] = (StgClosure *)SpW(i-2);
} }
// No write barrier is needed here as this is a new allocation write_barrier();
SET_HDR(new_aps,&stg_AP_STACK_info,cap->r.rCCCS); SET_HDR(new_aps,&stg_AP_STACK_info,cap->r.rCCCS);
// Arrange the stack to call the breakpoint IO action, and // Arrange the stack to call the breakpoint IO action, and
...@@ -1424,41 +1426,37 @@ run_BCO: ...@@ -1424,41 +1426,37 @@ run_BCO:
case bci_ALLOC_AP: { case bci_ALLOC_AP: {
int n_payload = BCO_NEXT; int n_payload = BCO_NEXT;
StgAP *ap = (StgAP*)allocate(cap, AP_sizeW(n_payload)); StgAP* ap = (StgAP*)allocate(cap, AP_sizeW(n_payload));
SpW(-1) = (W_)ap;
ap->n_args = n_payload; ap->n_args = n_payload;
ap->arity = 0; ap->arity = 0;
// No write barrier is needed here as this is a new allocation write_barrier();
// visible only from our stack
SET_HDR(ap, &stg_AP_info, cap->r.rCCCS) SET_HDR(ap, &stg_AP_info, cap->r.rCCCS)
SpW(-1) = (W_)ap;
Sp_subW(1); Sp_subW(1);
goto nextInsn; goto nextInsn;
} }
case bci_ALLOC_AP_NOUPD: { case bci_ALLOC_AP_NOUPD: {
int n_payload = BCO_NEXT; int n_payload = BCO_NEXT;
StgAP *ap = (StgAP*)allocate(cap, AP_sizeW(n_payload)); StgAP* ap = (StgAP*)allocate(cap, AP_sizeW(n_payload));
SpW(-1) = (W_)ap;
ap->n_args = n_payload; ap->n_args = n_payload;
ap->arity = 0; ap->arity = 0;
// No write barrier is needed here as this is a new allocation write_barrier();
// visible only from our stack
SET_HDR(ap, &stg_AP_NOUPD_info, cap->r.rCCCS) SET_HDR(ap, &stg_AP_NOUPD_info, cap->r.rCCCS)
SpW(-1) = (W_)ap;
Sp_subW(1); Sp_subW(1);
goto nextInsn; goto nextInsn;
} }
case bci_ALLOC_PAP: { case bci_ALLOC_PAP: {
StgPAP* pap;
int arity = BCO_NEXT; int arity = BCO_NEXT;
int n_payload = BCO_NEXT; int n_payload = BCO_NEXT;
pap = (StgPAP*)allocate(cap, PAP_sizeW(n_payload)); StgPAP* pap = (StgPAP*)allocate(cap, PAP_sizeW(n_payload));
SpW(-1) = (W_)pap;
pap->n_args = n_payload; pap->n_args = n_payload;
pap->arity = arity; pap->arity = arity;
// No write barrier is needed here as this is a new allocation write_barrier();
// visible only from our stack
SET_HDR(pap, &stg_PAP_info, cap->r.rCCCS) SET_HDR(pap, &stg_PAP_info, cap->r.rCCCS)
SpW(-1) = (W_)pap;
Sp_subW(1); Sp_subW(1);
goto nextInsn; goto nextInsn;
} }
...@@ -1529,6 +1527,7 @@ run_BCO: ...@@ -1529,6 +1527,7 @@ run_BCO:
int o_itbl = BCO_GET_LARGE_ARG; int o_itbl = BCO_GET_LARGE_ARG;
int n_words = BCO_NEXT; int n_words = BCO_NEXT;
StgInfoTable* itbl = INFO_PTR_TO_STRUCT((StgInfoTable *)BCO_LIT(o_itbl)); StgInfoTable* itbl = INFO_PTR_TO_STRUCT((StgInfoTable *)BCO_LIT(o_itbl));
load_load_barrier();
int request = CONSTR_sizeW( itbl->layout.payload.ptrs, int request = CONSTR_sizeW( itbl->layout.payload.ptrs,
itbl->layout.payload.nptrs ); itbl->layout.payload.nptrs );
StgClosure* con = (StgClosure*)allocate_NONUPD(cap,request); StgClosure* con = (StgClosure*)allocate_NONUPD(cap,request);
...@@ -1538,8 +1537,7 @@ run_BCO: ...@@ -1538,8 +1537,7 @@ run_BCO:
} }
Sp_addW(n_words); Sp_addW(n_words);
Sp_subW(1); Sp_subW(1);
// No write barrier is needed here as this is a new allocation write_barrier();
// visible only from our stack
SET_HDR(con, (StgInfoTable*)BCO_LIT(o_itbl), cap->r.rCCCS); SET_HDR(con, (StgInfoTable*)BCO_LIT(o_itbl), cap->r.rCCCS);
SpW(0) = (W_)con; SpW(0) = (W_)con;
IF_DEBUG(interpreter, IF_DEBUG(interpreter,
......
...@@ -28,6 +28,7 @@ void sendMessage(Capability *from_cap, Capability *to_cap, Message *msg) ...@@ -28,6 +28,7 @@ void sendMessage(Capability *from_cap, Capability *to_cap, Message *msg)
#if defined(DEBUG) #if defined(DEBUG)
{ {
const StgInfoTable *i = msg->header.info; const StgInfoTable *i = msg->header.info;
load_load_barrier();
if (i != &stg_MSG_THROWTO_info && if (i != &stg_MSG_THROWTO_info &&
i != &stg_MSG_BLACKHOLE_info && i != &stg_MSG_BLACKHOLE_info &&
i != &stg_MSG_TRY_WAKEUP_info && i != &stg_MSG_TRY_WAKEUP_info &&
...@@ -70,6 +71,7 @@ executeMessage (Capability *cap, Message *m) ...@@ -70,6 +71,7 @@ executeMessage (Capability *cap, Message *m)
loop: loop:
write_barrier(); // allow m->header to be modified by another thread write_barrier(); // allow m->header to be modified by another thread
i = m->header.info; i = m->header.info;
load_load_barrier();
if (i == &stg_MSG_TRY_WAKEUP_info) if (i == &stg_MSG_TRY_WAKEUP_info)
{ {
StgTSO *tso = ((MessageWakeup *)m)->tso; StgTSO *tso = ((MessageWakeup *)m)->tso;
...@@ -302,6 +304,7 @@ loop: ...@@ -302,6 +304,7 @@ loop:
recordClosureMutated(cap,(StgClosure*)msg); recordClosureMutated(cap,(StgClosure*)msg);
if (info == &stg_BLOCKING_QUEUE_CLEAN_info) { if (info == &stg_BLOCKING_QUEUE_CLEAN_info) {
write_barrier();
bq->header.info = &stg_BLOCKING_QUEUE_DIRTY_info; bq->header.info = &stg_BLOCKING_QUEUE_DIRTY_info;
// No barrier is necessary here: we are only exposing the // No barrier is necessary here: we are only exposing the
// closure to the GC. See Note [Heap memory barriers] in SMP.h. // closure to the GC. See Note [Heap memory barriers] in SMP.h.
...@@ -334,6 +337,7 @@ StgTSO * blackHoleOwner (StgClosure *bh) ...@@ -334,6 +337,7 @@ StgTSO * blackHoleOwner (StgClosure *bh)
StgClosure *p; StgClosure *p;
info = bh->header.info; info = bh->header.info;
load_load_barrier();
if (info != &stg_BLACKHOLE_info && if (info != &stg_BLACKHOLE_info &&
info != &stg_CAF_BLACKHOLE_info && info != &stg_CAF_BLACKHOLE_info &&
...@@ -349,6 +353,7 @@ loop: ...@@ -349,6 +353,7 @@ loop:
// and turns this into an infinite loop. // and turns this into an infinite loop.
p = UNTAG_CLOSURE((StgClosure*)VOLATILE_LOAD(&((StgInd*)bh)->indirectee)); p = UNTAG_CLOSURE((StgClosure*)VOLATILE_LOAD(&((StgInd*)bh)->indirectee));
info = p->header.info; info = p->header.info;
load_load_barrier();
if (info == &stg_IND_info) goto loop; if (info == &stg_IND_info) goto loop;
......
...@@ -68,8 +68,9 @@ stg_newByteArrayzh ( W_ n ) ...@@ -68,8 +68,9 @@ stg_newByteArrayzh ( W_ n )
jump stg_raisezh(base_GHCziIOziException_heapOverflow_closure); jump stg_raisezh(base_GHCziIOziException_heapOverflow_closure);
} }
TICK_ALLOC_PRIM(SIZEOF_StgArrBytes,WDS(payload_words),0); TICK_ALLOC_PRIM(SIZEOF_StgArrBytes,WDS(payload_words),0);
SET_HDR(p, stg_ARR_WORDS_info, CCCS);
StgArrBytes_bytes(p) = n; StgArrBytes_bytes(p) = n;
prim_write_barrier;
SET_HDR(p, stg_ARR_WORDS_info, CCCS);
return (p); return (p);
} }
...@@ -98,9 +99,9 @@ stg_newPinnedByteArrayzh ( W_ n ) ...@@ -98,9 +99,9 @@ stg_newPinnedByteArrayzh ( W_ n )
} }
TICK_ALLOC_PRIM(SIZEOF_StgArrBytes,WDS(payload_words),0); TICK_ALLOC_PRIM(SIZEOF_StgArrBytes,WDS(payload_words),0);
/* No write barrier needed since this is a new allocation. */
SET_HDR(p, stg_ARR_WORDS_info, CCCS);
StgArrBytes_bytes(p) = n; StgArrBytes_bytes(p) = n;
prim_write_barrier;
SET_HDR(p, stg_ARR_WORDS_info, CCCS);
return (p); return (p);
} }
...@@ -133,9 +134,9 @@ stg_newAlignedPinnedByteArrayzh ( W_ n, W_ alignment ) ...@@ -133,9 +134,9 @@ stg_newAlignedPinnedByteArrayzh ( W_ n, W_ alignment )
} }
TICK_ALLOC_PRIM(SIZEOF_StgArrBytes,WDS(payload_words),0); TICK_ALLOC_PRIM(SIZEOF_StgArrBytes,WDS(payload_words),0);
/* No write barrier needed since this is a new allocation. */
SET_HDR(p, stg_ARR_WORDS_info, CCCS);
StgArrBytes_bytes(p) = n; StgArrBytes_bytes(p) = n;
prim_write_barrier;
SET_HDR(p, stg_ARR_WORDS_info, CCCS);
return (p); return (p);
} }
...@@ -268,8 +269,6 @@ stg_newArrayzh ( W_ n /* words */, gcptr init ) ...@@ -268,8 +269,6 @@ stg_newArrayzh ( W_ n /* words */, gcptr init )
} }
TICK_ALLOC_PRIM(SIZEOF_StgMutArrPtrs, WDS(size), 0); TICK_ALLOC_PRIM(SIZEOF_StgMutArrPtrs, WDS(size), 0);
/* No write barrier needed since this is a new allocation. */
SET_HDR(arr, stg_MUT_ARR_PTRS_DIRTY_info, CCCS);
StgMutArrPtrs_ptrs(arr) = n; StgMutArrPtrs_ptrs(arr) = n;
StgMutArrPtrs_size(arr) = size; StgMutArrPtrs_size(arr) = size;
...@@ -282,6 +281,9 @@ stg_newArrayzh ( W_ n /* words */, gcptr init ) ...@@ -282,6 +281,9 @@ stg_newArrayzh ( W_ n /* words */, gcptr init )
goto for; goto for;
} }
prim_write_barrier;
SET_HDR(arr, stg_MUT_ARR_PTRS_DIRTY_info, CCCS);
return (arr); return (arr);
} }
...@@ -293,11 +295,13 @@ stg_unsafeThawArrayzh ( gcptr arr ) ...@@ -293,11 +295,13 @@ stg_unsafeThawArrayzh ( gcptr arr )
// mut_list so no need to add it again. MUT_ARR_PTRS_FROZEN_CLEAN means it's // mut_list so no need to add it again. MUT_ARR_PTRS_FROZEN_CLEAN means it's
// not and we should add it to a mut_list. // not and we should add it to a mut_list.
if (StgHeader_info(arr) != stg_MUT_ARR_PTRS_FROZEN_DIRTY_info) { if (StgHeader_info(arr) != stg_MUT_ARR_PTRS_FROZEN_DIRTY_info) {
prim_write_barrier; // see below:
SET_INFO(arr,stg_MUT_ARR_PTRS_DIRTY_info); SET_INFO(arr,stg_MUT_ARR_PTRS_DIRTY_info);
// must be done after SET_INFO, because it ASSERTs closure_MUTABLE(): // must be done after SET_INFO, because it ASSERTs closure_MUTABLE():
recordMutable(arr); recordMutable(arr);
return (arr); return (arr);
} else { } else {
prim_write_barrier;
SET_INFO(arr,stg_MUT_ARR_PTRS_DIRTY_info); SET_INFO(arr,stg_MUT_ARR_PTRS_DIRTY_info);
return (arr); return (arr);
} }
...@@ -390,7 +394,6 @@ stg_newArrayArrayzh ( W_ n /* words */ ) ...@@ -390,7 +394,6 @@ stg_newArrayArrayzh ( W_ n /* words */ )
} }
TICK_ALLOC_PRIM(SIZEOF_StgMutArrPtrs, WDS(size), 0); TICK_ALLOC_PRIM(SIZEOF_StgMutArrPtrs, WDS(size), 0);
SET_HDR(arr, stg_MUT_ARR_PTRS_DIRTY_info, W_[CCCS]);
StgMutArrPtrs_ptrs(arr) = n; StgMutArrPtrs_ptrs(arr) = n;
StgMutArrPtrs_size(arr) = size; StgMutArrPtrs_size(arr) = size;
...@@ -403,6 +406,9 @@ stg_newArrayArrayzh ( W_ n /* words */ ) ...@@ -403,6 +406,9 @@ stg_newArrayArrayzh ( W_ n /* words */ )
goto for; goto for;
} }
prim_write_barrier;
SET_HDR(arr, stg_MUT_ARR_PTRS_DIRTY_info, W_[CCCS]);
return (arr); return (arr);
} }
...@@ -425,8 +431,6 @@ stg_newSmallArrayzh ( W_ n /* words */, gcptr init ) ...@@ -425,8 +431,6 @@ stg_newSmallArrayzh ( W_ n /* words */, gcptr init )
} }
TICK_ALLOC_PRIM(SIZEOF_StgSmallMutArrPtrs, WDS(n), 0); TICK_ALLOC_PRIM(SIZEOF_StgSmallMutArrPtrs, WDS(n), 0);
/* No write barrier needed since this is a new allocation. */
SET_HDR(arr, stg_SMALL_MUT_ARR_PTRS_DIRTY_info, CCCS);
StgSmallMutArrPtrs_ptrs(arr) = n; StgSmallMutArrPtrs_ptrs(arr) = n;
// Initialise all elements of the array with the value in R2 // Initialise all elements of the array with the value in R2
...@@ -441,6 +445,9 @@ stg_newSmallArrayzh ( W_ n /* words */, gcptr init ) ...@@ -441,6 +445,9 @@ stg_newSmallArrayzh ( W_ n /* words */, gcptr init )
goto for; goto for;
} }
prim_write_barrier;
SET_HDR(arr, stg_SMALL_MUT_ARR_PTRS_DIRTY_info, CCCS);
return (arr); return (arr);
} }
...@@ -449,11 +456,13 @@ stg_unsafeThawSmallArrayzh ( gcptr arr ) ...@@ -449,11 +456,13 @@ stg_unsafeThawSmallArrayzh ( gcptr arr )
// See stg_unsafeThawArrayzh // See stg_unsafeThawArrayzh
if (StgHeader_info(arr) != stg_SMALL_MUT_ARR_PTRS_FROZEN_DIRTY_info) { if (StgHeader_info(arr) != stg_SMALL_MUT_ARR_PTRS_FROZEN_DIRTY_info) {
SET_INFO(arr, stg_SMALL_MUT_ARR_PTRS_DIRTY_info); SET_INFO(arr, stg_SMALL_MUT_ARR_PTRS_DIRTY_info);
prim_write_barrier;
recordMutable(arr); recordMutable(arr);
// must be done after SET_INFO, because it ASSERTs closure_MUTABLE() // must be done after SET_INFO, because it ASSERTs closure_MUTABLE()
return (arr); return (arr);
} else { } else {
SET_INFO(arr, stg_SMALL_MUT_ARR_PTRS_DIRTY_info); SET_INFO(arr, stg_SMALL_MUT_ARR_PTRS_DIRTY_info);
prim_write_barrier;
return (arr); return (arr);
} }
} }
...@@ -511,12 +520,13 @@ stg_copySmallArrayzh ( gcptr src, W_ src_off, gcptr dst, W_ dst_off, W_ n) ...@@ -511,12 +520,13 @@ stg_copySmallArrayzh ( gcptr src, W_ src_off, gcptr dst, W_ dst_off, W_ n)
dst, dst_off, n); dst, dst_off, n);
} }
SET_INFO(dst, stg_SMALL_MUT_ARR_PTRS_DIRTY_info);
dst_p = dst + SIZEOF_StgSmallMutArrPtrs + WDS(dst_off); dst_p = dst + SIZEOF_StgSmallMutArrPtrs + WDS(dst_off);
src_p = src + SIZEOF_StgSmallMutArrPtrs + WDS(src_off); src_p = src + SIZEOF_StgSmallMutArrPtrs + WDS(src_off);
bytes = WDS(n); bytes = WDS(n);
prim %memcpy(dst_p, src_p, bytes, SIZEOF_W); prim %memcpy(dst_p, src_p, bytes, SIZEOF_W);
prim_write_barrier;
SET_INFO(dst, stg_SMALL_MUT_ARR_PTRS_DIRTY_info);
} }
return (); return ();
...@@ -532,8 +542,6 @@ stg_copySmallMutableArrayzh ( gcptr src, W_ src_off, gcptr dst, W_ dst_off, W_ n ...@@ -532,8 +542,6 @@ stg_copySmallMutableArrayzh ( gcptr src, W_ src_off, gcptr dst, W_ dst_off, W_ n
dst, dst_off, n); dst, dst_off, n);
} }
SET_INFO(dst, stg_SMALL_MUT_ARR_PTRS_DIRTY_info);
dst_p = dst + SIZEOF_StgSmallMutArrPtrs + WDS(dst_off); dst_p = dst + SIZEOF_StgSmallMutArrPtrs + WDS(dst_off);
src_p = src + SIZEOF_StgSmallMutArrPtrs + WDS(src_off); src_p = src + SIZEOF_StgSmallMutArrPtrs + WDS(src_off);
bytes = WDS(n); bytes = WDS(n);
...@@ -542,6 +550,9 @@ stg_copySmallMutableArrayzh ( gcptr src, W_ src_off, gcptr dst, W_ dst_off, W_ n ...@@ -542,6 +550,9 @@ stg_copySmallMutableArrayzh ( gcptr src, W_ src_off, gcptr dst, W_ dst_off, W_ n
} else { } else {
prim %memcpy(dst_p, src_p, bytes, SIZEOF_W); prim %memcpy(dst_p, src_p, bytes, SIZEOF_W);
} }
prim_write_barrier;
SET_INFO(dst, stg_SMALL_MUT_ARR_PTRS_DIRTY_info);
} }
return (); return ();
...@@ -583,9 +594,9 @@ stg_newMutVarzh ( gcptr init ) ...@@ -583,9 +594,9 @@ stg_newMutVarzh ( gcptr init )
ALLOC_PRIM_P (SIZEOF_StgMutVar, stg_newMutVarzh, init); ALLOC_PRIM_P (SIZEOF_StgMutVar, stg_newMutVarzh, init);
mv = Hp - SIZEOF_StgMutVar + WDS(1); mv = Hp - SIZEOF_StgMutVar + WDS(1);
/* No write barrier needed since this is a new allocation. */
SET_HDR(mv,stg_MUT_VAR_DIRTY_info,CCCS);
StgMutVar_var(mv) = init; StgMutVar_var(mv) = init;
prim_write_barrier;
SET_HDR(mv,stg_MUT_VAR_DIRTY_info,CCCS);
return (mv); return (mv);
} }
...@@ -668,16 +679,18 @@ stg_atomicModifyMutVar2zh ( gcptr mv, gcptr f ) ...@@ -668,16 +679,18 @@ stg_atomicModifyMutVar2zh ( gcptr mv, gcptr f )
TICK_ALLOC_THUNK_2(); TICK_ALLOC_THUNK_2();
CCCS_ALLOC(THUNK_2_SIZE); CCCS_ALLOC(THUNK_2_SIZE);
z = Hp - THUNK_2_SIZE + WDS(1); z = Hp - THUNK_2_SIZE + WDS(1);
SET_HDR(z, stg_ap_2_upd_info, CCCS);
LDV_RECORD_CREATE(z); LDV_RECORD_CREATE(z);
StgThunk_payload(z,0) = f; StgThunk_payload(z,0) = f;
prim_write_barrier;
SET_HDR(z, stg_ap_2_upd_info, CCCS);
TICK_ALLOC_THUNK_1(); TICK_ALLOC_THUNK_1();
CCCS_ALLOC(THUNK_1_SIZE); CCCS_ALLOC(THUNK_1_SIZE);
y = z - THUNK_1_SIZE; y = z - THUNK_1_SIZE;
SET_HDR(y, stg_sel_0_upd_info, CCCS);
LDV_RECORD_CREATE(y); LDV_RECORD_CREATE(y);
StgThunk_payload(y,0) = z; StgThunk_payload(y,0) = z;
prim_write_barrier;
SET_HDR(y, stg_sel_0_upd_info, CCCS);
retry: retry:
x = StgMutVar_var(mv); x = StgMutVar_var(mv);
...@@ -728,9 +741,10 @@ stg_atomicModifyMutVarzuzh ( gcptr mv, gcptr f ) ...@@ -728,9 +741,10 @@ stg_atomicModifyMutVarzuzh ( gcptr mv, gcptr f )
TICK_ALLOC_THUNK(); TICK_ALLOC_THUNK();
CCCS_ALLOC(THUNK_SIZE); CCCS_ALLOC(THUNK_SIZE);
z = Hp - THUNK_SIZE + WDS(1); z = Hp - THUNK_SIZE + WDS(1);
SET_HDR(z, stg_ap_2_upd_info, CCCS);
LDV_RECORD_CREATE(z); LDV_RECORD_CREATE(z);
StgThunk_payload(z,0) = f; StgThunk_payload(z,0) = f;
prim_write_barrier;
SET_HDR(z, stg_ap_2_upd_info, CCCS);
retry: retry:
x = StgMutVar_var(mv); x = StgMutVar_var(mv);
...@@ -763,8 +777,6 @@ stg_mkWeakzh ( gcptr key, ...@@ -763,8 +777,6 @@ stg_mkWeakzh ( gcptr key,
ALLOC_PRIM (SIZEOF_StgWeak) ALLOC_PRIM (SIZEOF_StgWeak)
w = Hp - SIZEOF_StgWeak + WDS(1); w = Hp - SIZEOF_StgWeak + WDS(1);