summaryrefslogtreecommitdiff
path: root/rts
diff options
context:
space:
mode:
authorBen Gamari <bgamari.foss@gmail.com>2018-05-19 14:00:59 -0400
committerBen Gamari <ben@smart-cactus.org>2018-05-20 11:01:34 -0400
commit12deb9a97c05ad462ef04e8d2062c3d11c52c6ff (patch)
tree5b78115a49007ea49d4f36653d2c953ca3498f74 /rts
parentc4219d9f7d122a106fc8fb1e5cd9a62dadadf76c (diff)
downloadhaskell-12deb9a97c05ad462ef04e8d2062c3d11c52c6ff.tar.gz
rts: Fix compaction of SmallMutArrPtrs
This was blatantly wrong due to copy-paste blindness: * labels were shadowed, which GHC doesn't warn about(!), resulting in plainly wrong behavior * the sharing check was omitted * the wrong closure layout was being used Moreover, the test wasn't being run due to its primitive dependency, so I didn't even notice. Sillyness. Test Plan: install `primitive`, `make test TEST=compact_small_array` Reviewers: simonmar, erikd Reviewed By: simonmar Subscribers: rwbarton, thomie, carter GHC Trac Issues: #13857. Differential Revision: https://phabricator.haskell.org/D4702
Diffstat (limited to 'rts')
-rw-r--r--rts/Compact.cmm28
1 files changed, 15 insertions, 13 deletions
diff --git a/rts/Compact.cmm b/rts/Compact.cmm
index 719dac87f1..2c8a030ed1 100644
--- a/rts/Compact.cmm
+++ b/rts/Compact.cmm
@@ -189,24 +189,26 @@ eval:
SMALL_MUT_ARR_PTRS_FROZEN0,
SMALL_MUT_ARR_PTRS_FROZEN: {
- W_ i, size, ptrs;
- size = SIZEOF_StgMutArrPtrs + WDS(StgMutArrPtrs_size(p));
- ptrs = StgMutArrPtrs_ptrs(p);
- ALLOCATE(compact, BYTES_TO_WDS(size), p, to, tag);
+ (should) = ccall shouldCompact(compact "ptr", p "ptr");
+ if (should == SHOULDCOMPACT_IN_CNF) { P_[pp] = p; return(); }
+
+ CHECK_HASH();
+
+ W_ i, ptrs;
+ ptrs = StgSmallMutArrPtrs_ptrs(p);
+ ALLOCATE(compact, BYTES_TO_WDS(SIZEOF_StgSmallMutArrPtrs) + ptrs, p, to, tag);
P_[pp] = tag | to;
SET_HDR(to, StgHeader_info(p), StgHeader_ccs(p));
- StgMutArrPtrs_ptrs(to) = ptrs;
- StgMutArrPtrs_size(to) = StgMutArrPtrs_size(p);
- prim %memcpy(to, p, size, 1);
+ StgSmallMutArrPtrs_ptrs(to) = ptrs;
i = 0;
- loop0:
+ loop1:
if (i < ptrs) ( likely: True ) {
W_ q;
q = to + SIZEOF_StgSmallMutArrPtrs + WDS(i);
call stg_compactAddWorkerzh(
compact, P_[p + SIZEOF_StgSmallMutArrPtrs + WDS(i)], q);
i = i + 1;
- goto loop0;
+ goto loop1;
}
return();
}
@@ -238,16 +240,16 @@ eval:
// First, copy the non-pointers
if (nptrs > 0) {
i = ptrs;
- loop1:
+ loop2:
StgClosure_payload(to,i) = StgClosure_payload(p,i);
i = i + 1;
- if (i < ptrs + nptrs) ( likely: True ) goto loop1;
+ if (i < ptrs + nptrs) ( likely: True ) goto loop2;
}
// Next, recursively compact and copy the pointers
if (ptrs == 0) { return(); }
i = 0;
- loop2:
+ loop3:
W_ q;
q = to + SIZEOF_StgHeader + OFFSET_StgClosure_payload + WDS(i);
// Tail-call the last one. This means we don't build up a deep
@@ -257,7 +259,7 @@ eval:
}
call stg_compactAddWorkerzh(compact, StgClosure_payload(p,i), q);
i = i + 1;
- goto loop2;
+ goto loop3;
}
// these might be static closures that we can avoid copying into