JS: fix for overlap with copyMutableByteArray# (#23033)

The code wasn't taking into account some kind of overlap.

cgrun070 has been extended to test the missing case.

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]