summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--compiler/GHC/StgToJS/Prim.hs11
-rw-r--r--rts/js/mem.js23
-rw-r--r--testsuite/tests/codeGen/should_run/CopySmallArray.hs13
-rw-r--r--testsuite/tests/codeGen/should_run/CopySmallArray.stdout1
-rw-r--r--testsuite/tests/codeGen/should_run/cgrun070.hs13
-rw-r--r--testsuite/tests/codeGen/should_run/cgrun070.stdout1
6 files changed, 48 insertions, 14 deletions
diff --git a/compiler/GHC/StgToJS/Prim.hs b/compiler/GHC/StgToJS/Prim.hs
index 8687b1db72..a29c08db93 100644
--- a/compiler/GHC/StgToJS/Prim.hs
+++ b/compiler/GHC/StgToJS/Prim.hs
@@ -573,11 +573,7 @@ genPrim prof bound ty op = case op of
[ d .! (Add di i) |= s .! (Add si i)
, postDecrS i
]
- CopySmallMutableArrayOp -> \[] [s,si,d,di,n] -> PrimInline $
- loopBlockS (Sub n one_) (.>=. zero_) \i ->
- [ d .! (Add di i) |= s .! (Add si i)
- , postDecrS i
- ]
+ CopySmallMutableArrayOp -> \[] [s,si,d,di,n] -> PrimInline $ appS "h$copyMutableArray" [s,si,d,di,n]
CloneSmallArrayOp -> \[r] [a,o,n] -> PrimInline $ cloneArray r a (Just o) n
CloneSmallMutableArrayOp -> \[r] [a,o,n] -> PrimInline $ cloneArray r a (Just o) n
FreezeSmallArrayOp -> \[r] [a,o,n] -> PrimInline $ cloneArray r a (Just o) n
@@ -719,10 +715,7 @@ genPrim prof bound ty op = case op of
CopyByteArrayOp -> \[] [a1,o1,a2,o2,n] ->
PrimInline . boundsChecked bound a1 (Add o1 (Sub n 1))
. boundsChecked bound a2 (Add o2 (Sub n 1))
- $ loopBlockS (Sub n one_) (.>=. zero_) \i ->
- [ write_u8 a2 (Add i o2) (read_u8 a1 (Add i o1))
- , postDecrS i
- ]
+ $ appS "h$copyMutableByteArray" [a1,o1,a2,o2,n]
CopyMutableByteArrayOp -> \[] xs@[_a1,_o1,_a2,_o2,_n] -> genPrim prof bound ty CopyByteArrayOp [] xs
CopyByteArrayToAddrOp -> \[] xs@[_a1,_o1,_a2,_o2,_n] -> genPrim prof bound ty CopyByteArrayOp [] xs
CopyMutableByteArrayToAddrOp -> \[] xs@[_a1,_o1,_a2,_o2,_n] -> genPrim prof bound ty CopyByteArrayOp [] xs
diff --git a/rts/js/mem.js b/rts/js/mem.js
index c1f586c282..3dcdc7979f 100644
--- a/rts/js/mem.js
+++ b/rts/js/mem.js
@@ -531,12 +531,17 @@ function h$sliceArray(a, start, n) {
return r;
}
+//////////////////////////////////////////////////////////
+//
// copy between two mutable arrays. Range may overlap
+// so we check which offset is bigger to make a front-to-back or
+// back-to-front traversal of the arrays.
+
function h$copyMutableArray(a1,o1,a2,o2,n) {
if (n <= 0) return;
if (o1 < o2) {
- for (var i=n-1;i>=0;i--) { // start from the end to handle potential overlap
+ for (var i=n-1;i>=0;i--) {
a2[o2+i] = a1[o1+i];
}
} else {
@@ -546,6 +551,22 @@ function h$copyMutableArray(a1,o1,a2,o2,n) {
}
}
+function h$copyMutableByteArray(a1,o1,a2,o2,n) {
+ if (n <= 0) return;
+
+ if (o1 < o2) {
+ for (var i=n-1;i>=0;i--) {
+ a2.u8[o2+i] = a1.u8[o1+i];
+ }
+ } else {
+ for (var i=0;i<n;i++) {
+ a2.u8[o2+i] = a1.u8[o1+i];
+ }
+ }
+}
+
+//////////////////////////////////////////////////////////
+
function h$memcpy() {
if(arguments.length === 3) { // ByteArray# -> ByteArray# copy
var dst = arguments[0];
diff --git a/testsuite/tests/codeGen/should_run/CopySmallArray.hs b/testsuite/tests/codeGen/should_run/CopySmallArray.hs
index e3a5143ac8..26f244c490 100644
--- a/testsuite/tests/codeGen/should_run/CopySmallArray.hs
+++ b/testsuite/tests/codeGen/should_run/CopySmallArray.hs
@@ -76,12 +76,21 @@ test_copyMutableArray =
-- Perform a copy where the source and destination part overlap.
test_copyMutableArrayOverlap :: String
test_copyMutableArrayOverlap =
- let arr = runST $ do
+ let arr1 = runST $ do
marr <- fromList inp
-- Overlap of two elements
copyMutableArray marr 5 marr 7 8
unsafeFreezeArray marr
- in shows (toList arr (length inp)) "\n"
+ arr2 = runST $ do
+ marr <- fromList inp
+ -- Overlap of two elements
+ -- Offset 1 > offset 2 (cf #23033)
+ copyMutableArray marr 7 marr 5 8
+ unsafeFreezeArray marr
+ in shows (toList arr1 (length inp))
+ . showChar '\n'
+ . shows (toList arr2 (length inp))
+ $ "\n"
where
-- This case was known to fail at some point.
inp = [0,169,196,9,16,25,36,16,25,81,100,121,144,169,196]
diff --git a/testsuite/tests/codeGen/should_run/CopySmallArray.stdout b/testsuite/tests/codeGen/should_run/CopySmallArray.stdout
index 86ad8a276c..3308687344 100644
--- a/testsuite/tests/codeGen/should_run/CopySmallArray.stdout
+++ b/testsuite/tests/codeGen/should_run/CopySmallArray.stdout
@@ -3,6 +3,7 @@
[-1,1,4,9,16,25,36,49,64,81,100,121,144,169,196,225,256,289,324,361,400,441,484,529,576,625,676,729,784,841,900,961,1024,1089,1156,1225,1296,1369,1444,1521,1600,1681,1764,1849,1936,2025,2116,2209,2304,2401,2500,2601,2704,2809,2916,3025,3136,3249,3364,3481,3600,3721,3844,3969,4096,4225,4356,4489,4624,4761,4900,5041,5184,5329,5476,5625,5776,5929,6084,6241,6400,6561,6724,6889,7056,7225,7396,7569,7744,7921,8100,8281,8464,8649,8836,9025,9216,9409,9604,9801,10000,10201,10404,10609,10816,11025,11236,11449,11664,11881,12100,12321,12544,12769,12996,13225,13456,13689,13924,14161,14400,14641,14884,15129,15376,15625,15876,16129,16384,-1]
[0,169,196,9,16,25,36,25,36,16,25,81,100,121,144]
+[0,169,196,9,16,16,25,81,100,121,144,169,196,169,196]
[1,4,9,16,25,36,49,64,81,100,121,144,169,196,225,256,289,324,361,400,441,484,529,576,625,676,729,784,841,900,961,1024,1089,1156,1225,1296,1369,1444,1521,1600,1681,1764,1849,1936,2025,2116,2209,2304,2401,2500,2601,2704,2809,2916,3025,3136,3249,3364,3481,3600,3721,3844,3969,4096,4225,4356,4489,4624,4761,4900,5041,5184,5329,5476,5625,5776,5929,6084,6241,6400,6561,6724,6889,7056,7225,7396,7569,7744,7921,8100,8281,8464,8649,8836,9025,9216,9409,9604,9801,10000,10201,10404,10609,10816,11025,11236,11449,11664,11881,12100,12321,12544,12769,12996,13225,13456,13689,13924,14161,14400,14641,14884,15129,15376,15625,15876,16129,16384]
diff --git a/testsuite/tests/codeGen/should_run/cgrun070.hs b/testsuite/tests/codeGen/should_run/cgrun070.hs
index 6d16141202..6ada2e6083 100644
--- a/testsuite/tests/codeGen/should_run/cgrun070.hs
+++ b/testsuite/tests/codeGen/should_run/cgrun070.hs
@@ -74,12 +74,21 @@ test_copyMutableByteArray =
-- Perform a copy where the source and destination part overlap.
test_copyMutableByteArrayOverlap :: String
test_copyMutableByteArrayOverlap =
- let arr = runST $ do
+ let arr1 = runST $ do
marr <- fromList inp
-- Overlap of two elements
copyMutableByteArray marr 5 marr 7 8
unsafeFreezeByteArray marr
- in shows (toList arr (length inp)) "\n"
+ arr2 = runST $ do
+ marr <- fromList inp
+ -- Overlap of two elements
+ -- Offset 1 > offset 2 (cf #23033)
+ copyMutableByteArray marr 7 marr 5 8
+ unsafeFreezeByteArray marr
+ in shows (toList arr1 (length inp))
+ . showChar '\n'
+ . shows (toList arr2 (length inp))
+ $ "\n"
where
-- This case was known to fail at some point.
inp = [0,169,196,9,16,25,36,16,25,81,100,121,144,169,196]
diff --git a/testsuite/tests/codeGen/should_run/cgrun070.stdout b/testsuite/tests/codeGen/should_run/cgrun070.stdout
index 4c62f485cc..b0cbd43567 100644
--- a/testsuite/tests/codeGen/should_run/cgrun070.stdout
+++ b/testsuite/tests/codeGen/should_run/cgrun070.stdout
@@ -3,6 +3,7 @@
[255,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31,32,33,34,35,36,37,38,39,40,41,42,43,44,45,46,47,48,49,50,51,52,53,54,55,56,57,58,59,60,61,62,63,64,65,66,67,68,69,70,71,72,73,74,75,76,77,78,79,80,81,82,83,84,85,86,87,88,89,90,91,92,93,94,95,96,97,98,99,100,101,102,103,104,105,106,107,108,109,110,111,112,113,114,115,116,117,118,119,120,121,122,123,124,125,126,127,128,255]
[0,169,196,9,16,25,36,25,36,16,25,81,100,121,144]
+[0,169,196,9,16,16,25,81,100,121,144,169,196,169,196]
[255,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31,32,33,34,35,36,37,38,39,40,41,42,43,44,45,46,47,48,49,50,51,52,53,54,55,56,57,58,59,60,61,62,63,64,65,66,67,68,69,70,71,72,73,74,75,76,77,78,79,80,81,82,83,84,85,86,87,88,89,90,91,92,93,94,95,96,97,98,99,100,101,102,103,104,105,106,107,108,109,110,111,112,113,114,115,116,117,118,119,120,121,122,123,124,125,126,127,128,255]
View Lorry Controller Status