Commit 0d40fd75 authored by Ben Gamari's avatar Ben Gamari Committed by Ben Gamari

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

(cherry picked from commit 12deb9a9)
parent da3ed4d4
......@@ -3,6 +3,6 @@ import Data.Primitive.SmallArray
main :: IO ()
main = do
arr <- newSmallArray 5 (Just 'a')
arr <- newSmallArray 5 (Just 'a') >>= unsafeFreezeSmallArray
arr' <- compact arr
print $ getCompact arr'
fromListN 5 [Just 'a',Just 'a',Just 'a',Just 'a',Just 'a']
......@@ -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) {
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) goto loop1;
if (i < ptrs + nptrs) 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
......
Markdown is supported
0%
or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment