JS: fix bounds checking (Issue 23123)

* For ByteArray-based bounds-checking, the JavaScript backend must use the
`len` field, instead of the inbuild JavaScript `length` field.

* Range-based operations must also check both the start and end of the range
for bounds

* All indicies are valid for ranges of size zero, since they are essentially no-ops

* For cases of ByteArray accesses (e.g. read as Int), the end index is
(i * sizeof(type) + sizeof(type) - 1), while the previous implementation
uses (i + sizeof(type) - 1). In the Int32 example, this is (i * 4 + 3)

* IndexByteArrayOp_Word8As* primitives use byte array indicies (unlike
the previous point), but now check both start and end indicies

* Byte array copies now check if the arrays are the same by identity and
then if the ranges overlap.

4 files changed, 183 insertions, 112 deletions

diff --git a/compiler/GHC/StgToJS/Prim.hs b/compiler/GHC/StgToJS/Prim.hs
index 94fbd7395d..a841851af1 100644
--- a/compiler/GHC/StgToJS/Prim.hs
+++ b/compiler/GHC/StgToJS/Prim.hs
@@ -605,12 +605,12 @@ genPrim prof bound ty op = case op of
   SizeofByteArrayOp                 -> \[r] [a]         -> PrimInline $ r |= a .^ "len"
   SizeofMutableByteArrayOp          -> \[r] [a]         -> PrimInline $ r |= a .^ "len"
   GetSizeofMutableByteArrayOp       -> \[r] [a]         -> PrimInline $ r |= a .^ "len"
-  IndexByteArrayOp_Char             -> \[r] [a,i]       -> PrimInline . boundsChecked bound a i         $ r |= read_u8  a i
-  IndexByteArrayOp_WideChar         -> \[r] [a,i]       -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_i32 a i
-  IndexByteArrayOp_Int              -> \[r] [a,i]       -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_i32 a i
-  IndexByteArrayOp_Word             -> \[r] [a,i]       -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_u32 a i
+  IndexByteArrayOp_Char             -> \[r] [a,i]       -> PrimInline . boundsCheckedLen bound a i               $ r |= read_u8  a i
+  IndexByteArrayOp_WideChar         -> \[r] [a,i]       -> PrimInline . boundsCheckedLen bound a (byteIndex32 i) $ r |= read_i32 a i
+  IndexByteArrayOp_Int              -> \[r] [a,i]       -> PrimInline . boundsCheckedLen bound a (byteIndex32 i) $ r |= read_i32 a i
+  IndexByteArrayOp_Word             -> \[r] [a,i]       -> PrimInline . boundsCheckedLen bound a (byteIndex32 i) $ r |= read_u32 a i
   IndexByteArrayOp_Addr             -> \[r1,r2] [a,i]   ->
-    PrimInline . boundsChecked bound a i $ jVar \t -> mconcat
+    PrimInline . boundsCheckedLen bound a i $ jVar \t -> mconcat
       [ t |= a .^ "arr"
       , ifBlockS (t .&&. t .! (i .<<. two_))
           [ r1 |= t .! (i .<<. two_) .! zero_
@@ -621,31 +621,31 @@ genPrim prof bound ty op = case op of
           ]
       ]
 
-  IndexByteArrayOp_Float     -> \[r]     [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_f32 a i
-  IndexByteArrayOp_Double    -> \[r]     [a,i] -> PrimInline . boundsChecked bound a (Add i 7) $ r |= read_f64 a i
+  IndexByteArrayOp_Float     -> \[r]     [a,i] -> PrimInline . boundsCheckedLen bound a (byteIndex32 i) $ r |= read_f32 a i
+  IndexByteArrayOp_Double    -> \[r]     [a,i] -> PrimInline . boundsCheckedLen bound a (byteIndex64 i) $ r |= read_f64 a i
   IndexByteArrayOp_StablePtr -> \[r1,r2] [a,i] ->
-    PrimInline . boundsChecked bound a (Add i 3) $ mconcat
+    PrimInline . boundsCheckedLen bound a (byteIndex32 i) $ mconcat
       [ r1 |= var "h$stablePtrBuf"
       , r2 |= read_i32 a i
       ]
-  IndexByteArrayOp_Int8  -> \[r] [a,i]      -> PrimInline . boundsChecked bound a i         $ r |= read_i8  a i
-  IndexByteArrayOp_Int16 -> \[r] [a,i]      -> PrimInline . boundsChecked bound a (Add i 1) $ r |= read_i16 a i
-  IndexByteArrayOp_Int32 -> \[r] [a,i]      -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_i32 a i
-  IndexByteArrayOp_Int64 -> \[h,l] [a,i]    -> PrimInline . boundsChecked bound a (Add i 7) $ mconcat
+  IndexByteArrayOp_Int8  -> \[r] [a,i]      -> PrimInline . boundsCheckedLen bound a i               $ r |= read_i8  a i
+  IndexByteArrayOp_Int16 -> \[r] [a,i]      -> PrimInline . boundsCheckedLen bound a (byteIndex16 i) $ r |= read_i16 a i
+  IndexByteArrayOp_Int32 -> \[r] [a,i]      -> PrimInline . boundsCheckedLen bound a (byteIndex32 i) $ r |= read_i32 a i
+  IndexByteArrayOp_Int64 -> \[h,l] [a,i]    -> PrimInline . boundsCheckedLen bound a (byteIndex64 i) $ mconcat
                                                      [ h |= read_i32 a (Add (i .<<. one_) one_)
                                                      , l |= read_u32 a (i .<<. one_)
                                                      ]
-  IndexByteArrayOp_Word8  -> \[r] [a,i]     -> PrimInline . boundsChecked bound a i         $ r |= read_u8  a i
-  IndexByteArrayOp_Word16 -> \[r] [a,i]     -> PrimInline . boundsChecked bound a (Add i 1) $ r |= read_u16 a i
-  IndexByteArrayOp_Word32 -> \[r] [a,i]     -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_u32 a i
-  IndexByteArrayOp_Word64 -> \[h,l] [a,i] -> PrimInline . boundsChecked bound a (Add i 7) $ mconcat
+  IndexByteArrayOp_Word8  -> \[r] [a,i]     -> PrimInline . boundsCheckedLen bound a i               $ r |= read_u8  a i
+  IndexByteArrayOp_Word16 -> \[r] [a,i]     -> PrimInline . boundsCheckedLen bound a (byteIndex16 i) $ r |= read_u16 a i
+  IndexByteArrayOp_Word32 -> \[r] [a,i]     -> PrimInline . boundsCheckedLen bound a (byteIndex32 i) $ r |= read_u32 a i
+  IndexByteArrayOp_Word64 -> \[h,l] [a,i] -> PrimInline . boundsCheckedLen bound a (byteIndex64 i) $ mconcat
                                                       [ h |= read_u32 a (Add (i .<<. one_) one_)
                                                       , l |= read_u32 a (i .<<. one_)
                                                       ]
-  ReadByteArrayOp_Char     -> \[r]     [a,i] -> PrimInline . boundsChecked bound a i         $ r |= read_u8  a i
-  ReadByteArrayOp_WideChar -> \[r]     [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_i32 a i
-  ReadByteArrayOp_Int      -> \[r]     [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_i32 a i
-  ReadByteArrayOp_Word     -> \[r]     [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_u32 a i
+  ReadByteArrayOp_Char     -> \[r]     [a,i] -> PrimInline . boundsCheckedLen bound a i               $ r |= read_u8  a i
+  ReadByteArrayOp_WideChar -> \[r]     [a,i] -> PrimInline . boundsCheckedLen bound a (byteIndex32 i) $ r |= read_i32 a i
+  ReadByteArrayOp_Int      -> \[r]     [a,i] -> PrimInline . boundsCheckedLen bound a (byteIndex32 i) $ r |= read_i32 a i
+  ReadByteArrayOp_Word     -> \[r]     [a,i] -> PrimInline . boundsCheckedLen bound a (byteIndex32 i) $ r |= read_u32 a i
   ReadByteArrayOp_Addr     -> \[r1,r2] [a,i] ->
       PrimInline $ jVar \x -> mconcat
         [ x |= i .<<. two_
@@ -655,66 +655,67 @@ genPrim prof bound ty op = case op of
                         ])
                (mconcat [r1 |= null_, r2 |= one_])
         ]
-  ReadByteArrayOp_Float     -> \[r]     [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_f32 a i
-  ReadByteArrayOp_Double    -> \[r]     [a,i] -> PrimInline . boundsChecked bound a (Add i 7) $ r |= read_f64 a i
+  ReadByteArrayOp_Float     -> \[r]     [a,i] -> PrimInline . boundsCheckedLen bound a (byteIndex32 i) $ r |= read_f32 a i
+  ReadByteArrayOp_Double    -> \[r]     [a,i] -> PrimInline . boundsCheckedLen bound a (byteIndex64 i) $ r |= read_f64 a i
   ReadByteArrayOp_StablePtr -> \[r1,r2] [a,i] ->
-      PrimInline . boundsChecked bound a (Add i 3) $ mconcat
+      PrimInline . boundsCheckedLen bound a (byteIndex32 i) $ mconcat
        [ r1 |= var "h$stablePtrBuf"
        , r2 |= read_i32 a i
        ]
-  ReadByteArrayOp_Int8  -> \[r]     [a,i] -> PrimInline . boundsChecked bound a i         $ r |= read_i8  a i
-  ReadByteArrayOp_Int16 -> \[r]     [a,i] -> PrimInline . boundsChecked bound a (Add i 1) $ r |= read_i16 a i
-  ReadByteArrayOp_Int32 -> \[r]     [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_i32 a i
+  ReadByteArrayOp_Int8  -> \[r]     [a,i] -> PrimInline . boundsCheckedLen bound a i               $ r |= read_i8  a i
+  ReadByteArrayOp_Int16 -> \[r]     [a,i] -> PrimInline . boundsCheckedLen bound a (byteIndex16 i) $ r |= read_i16 a i
+  ReadByteArrayOp_Int32 -> \[r]     [a,i] -> PrimInline . boundsCheckedLen bound a (byteIndex32 i) $ r |= read_i32 a i
   ReadByteArrayOp_Int64 -> \[h,l]   [a,i] ->
-      PrimInline . boundsChecked bound a (Add i 7) $ mconcat
+      PrimInline . boundsCheckedLen bound a (byteIndex64 i) $ mconcat
         [ h |= read_i32 a (Add (i .<<. one_) one_)
         , l |= read_u32 a (i .<<. one_)
         ]
-  ReadByteArrayOp_Word8  -> \[r]     [a,i] -> PrimInline . boundsChecked bound a i         $ r |= read_u8  a i
-  ReadByteArrayOp_Word16 -> \[r]     [a,i] -> PrimInline . boundsChecked bound a (Add i 1) $ r |= read_u16 a i
-  ReadByteArrayOp_Word32 -> \[r]     [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_u32 a i
+  ReadByteArrayOp_Word8  -> \[r]     [a,i] -> PrimInline . boundsCheckedLen bound a i               $ r |= read_u8  a i
+  ReadByteArrayOp_Word16 -> \[r]     [a,i] -> PrimInline . boundsCheckedLen bound a (byteIndex16 i) $ r |= read_u16 a i
+  ReadByteArrayOp_Word32 -> \[r]     [a,i] -> PrimInline . boundsCheckedLen bound a (byteIndex32 i) $ r |= read_u32 a i
   ReadByteArrayOp_Word64 -> \[h,l]   [a,i] ->
-      PrimInline . boundsChecked bound a (Add i 7) $ mconcat
+      PrimInline . boundsCheckedLen bound a (byteIndex64 i) $ mconcat
         [ h |= read_u32 a (Add (i .<<. one_) one_)
         , l |= read_u32 a (i .<<. one_)
         ]
-  WriteByteArrayOp_Char     -> \[] [a,i,e]     -> PrimInline . boundsChecked bound a i         $ write_u8  a i e
-  WriteByteArrayOp_WideChar -> \[] [a,i,e]     -> PrimInline . boundsChecked bound a (Add i 3) $ write_i32 a i e
-  WriteByteArrayOp_Int      -> \[] [a,i,e]     -> PrimInline . boundsChecked bound a (Add i 3) $ write_i32 a i e
-  WriteByteArrayOp_Word     -> \[] [a,i,e]     -> PrimInline . boundsChecked bound a (Add i 3) $ write_u32 a i e
+  WriteByteArrayOp_Char     -> \[] [a,i,e]     -> PrimInline . boundsCheckedLen bound a i               $ write_u8  a i e
+  WriteByteArrayOp_WideChar -> \[] [a,i,e]     -> PrimInline . boundsCheckedLen bound a (byteIndex32 i) $ write_i32 a i e
+  WriteByteArrayOp_Int      -> \[] [a,i,e]     -> PrimInline . boundsCheckedLen bound a (byteIndex32 i) $ write_i32 a i e
+  WriteByteArrayOp_Word     -> \[] [a,i,e]     -> PrimInline . boundsCheckedLen bound a (byteIndex32 i) $ write_u32 a i e
   WriteByteArrayOp_Addr     -> \[] [a,i,e1,e2] ->
     PrimInline $ mconcat
       [ ifS (Not (a .^ "arr")) (a .^ "arr" |= ValExpr (JList [])) mempty
       , a .^ "arr" .! (i .<<. two_) |= ValExpr (JList [e1, e2])
       ]
-  WriteByteArrayOp_Float     -> \[] [a,i,e]      -> PrimInline . boundsChecked bound a (Add i 3) $ write_f32 a i e
-  WriteByteArrayOp_Double    -> \[] [a,i,e]      -> PrimInline . boundsChecked bound a (Add i 7) $ write_f64 a i e
-  WriteByteArrayOp_StablePtr -> \[] [a,i,_e1,e2] -> PrimInline . boundsChecked bound a (Add i 3) $ write_i32 a i e2
+  WriteByteArrayOp_Float     -> \[] [a,i,e]      -> PrimInline . boundsCheckedLen bound a (byteIndex32 i) $ write_f32 a i e
+  WriteByteArrayOp_Double    -> \[] [a,i,e]      -> PrimInline . boundsCheckedLen bound a (byteIndex64 i) $ write_f64 a i e
+  WriteByteArrayOp_StablePtr -> \[] [a,i,_e1,e2] -> PrimInline . boundsCheckedLen bound a (byteIndex32 i) $ write_i32 a i e2
 
-  WriteByteArrayOp_Int8  -> \[] [a,i,e]     -> PrimInline . boundsChecked bound a i         $ write_i8  a i e
-  WriteByteArrayOp_Int16 -> \[] [a,i,e]     -> PrimInline . boundsChecked bound a (Add i 1) $ write_i16 a i e
-  WriteByteArrayOp_Int32 -> \[] [a,i,e]     -> PrimInline . boundsChecked bound a (Add i 3) $ write_i32 a i e
+  WriteByteArrayOp_Int8  -> \[] [a,i,e]     -> PrimInline . boundsCheckedLen bound a i               $ write_i8  a i e
+  WriteByteArrayOp_Int16 -> \[] [a,i,e]     -> PrimInline . boundsCheckedLen bound a (byteIndex16 i) $ write_i16 a i e
+  WriteByteArrayOp_Int32 -> \[] [a,i,e]     -> PrimInline . boundsCheckedLen bound a (byteIndex32 i) $ write_i32 a i e
   WriteByteArrayOp_Int64 -> \[] [a,i,e1,e2] ->
-      PrimInline . boundsChecked bound a (Add i 7) $ mconcat
+      PrimInline . boundsCheckedLen bound a (byteIndex64 i) $ mconcat
         [ write_i32 a (Add (i .<<. one_) one_) e1
         , write_u32 a (i .<<. one_)            e2
         ]
-  WriteByteArrayOp_Word8  -> \[] [a,i,e]     -> PrimInline . boundsChecked bound a i         $ write_u8  a i e
-  WriteByteArrayOp_Word16 -> \[] [a,i,e]     -> PrimInline . boundsChecked bound a (Add i 1) $ write_u16 a i e
-  WriteByteArrayOp_Word32 -> \[] [a,i,e]     -> PrimInline . boundsChecked bound a (Add i 3) $ write_u32 a i e
+  WriteByteArrayOp_Word8  -> \[] [a,i,e]     -> PrimInline . boundsCheckedLen bound a i               $ write_u8  a i e
+  WriteByteArrayOp_Word16 -> \[] [a,i,e]     -> PrimInline . boundsCheckedLen bound a (byteIndex16 i) $ write_u16 a i e
+  WriteByteArrayOp_Word32 -> \[] [a,i,e]     -> PrimInline . boundsCheckedLen bound a (byteIndex32 i) $ write_u32 a i e
   WriteByteArrayOp_Word64 -> \[] [a,i,h,l] ->
-      PrimInline . boundsChecked bound a (Add i 7) $ mconcat
+      PrimInline . boundsCheckedLen bound a (byteIndex64 i) $ mconcat
         [ write_u32 a (Add (i .<<. one_) one_) h
         , write_u32 a (i .<<. one_)            l
         ]
   CompareByteArraysOp -> \[r] [a1,o1,a2,o2,n] ->
-      PrimInline . boundsChecked bound a1 (Add o1 (Sub n 1))
-                 . boundsChecked bound a2 (Add o2 (Sub n 1))
+      PrimInline . boundsCheckedRangeLen bound a1 o1 n
+                 . boundsCheckedRangeLen bound a2 o2 n
                  $ r |= app "h$compareByteArrays" [a1,o1,a2,o2,n]
 
   CopyByteArrayOp -> \[] [a1,o1,a2,o2,n] ->
-      PrimInline . boundsChecked bound a1 (Add o1 (Sub n 1))
-                 . boundsChecked bound a2 (Add o2 (Sub n 1))
+      PrimInline . boundsCheckedRangeLen bound a1 o1 n
+                 . boundsCheckedRangeLen bound a2 o2 n
+                 . checkOverlapByteArray bound a1 o1 a2 o2 n
                  $ appS "h$copyMutableByteArray" [a1,o1,a2,o2,n]
   CopyMutableByteArrayOp       -> \[] xs@[_a1,_o1,_a2,_o2,_n] -> genPrim prof bound ty CopyByteArrayOp [] xs
   CopyMutableByteArrayNonOverlappingOp -> \[] xs@[_a1,_o1,_a2,_o2,_n] -> genPrim prof bound ty CopyByteArrayOp [] xs
@@ -725,20 +726,20 @@ genPrim prof bound ty op = case op of
   CopyAddrToAddrNonOverlappingOp -> \[] xs@[_ba,_bo,_aa,_ao,_n] -> genPrim prof bound ty CopyByteArrayOp [] xs
 
   SetByteArrayOp -> \[] [a,o,n,v] ->
-      PrimInline . boundsChecked bound a (Add o (Sub n 1)) $ loopBlockS zero_ (.<. n) \i ->
+      PrimInline . boundsCheckedRangeLen bound a o n $ loopBlockS zero_ (.<. n) \i ->
         [ write_u8 a (Add o i) v
         , postIncrS i
         ]
   SetAddrRangeOp -> \[] xs@[_a,_o,_n,_v] -> genPrim prof bound ty SetByteArrayOp [] xs
 
-  AtomicReadByteArrayOp_Int  -> \[r]   [a,i]         -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_i32 a i
-  AtomicWriteByteArrayOp_Int -> \[]    [a,i,v]       -> PrimInline . boundsChecked bound a (Add i 3) $ write_i32 a i v
-  FetchAddByteArrayOp_Int    -> \[r]   [a,i,v] -> PrimInline . boundsChecked bound a (Add i 3) $ fetchOpByteArray Add  r a i v
-  FetchSubByteArrayOp_Int    -> \[r]   [a,i,v] -> PrimInline . boundsChecked bound a (Add i 3) $ fetchOpByteArray Sub  r a i v
-  FetchAndByteArrayOp_Int    -> \[r]   [a,i,v] -> PrimInline . boundsChecked bound a (Add i 3) $ fetchOpByteArray BAnd r a i v
-  FetchOrByteArrayOp_Int     -> \[r]   [a,i,v] -> PrimInline . boundsChecked bound a (Add i 3) $ fetchOpByteArray BOr  r a i v
-  FetchNandByteArrayOp_Int   -> \[r]   [a,i,v] -> PrimInline . boundsChecked bound a (Add i 3) $ fetchOpByteArray (\x y -> BNot (BAnd x y)) r a i v
-  FetchXorByteArrayOp_Int    -> \[r]   [a,i,v] -> PrimInline . boundsChecked bound a (Add i 3) $ fetchOpByteArray BXor r a i v
+  AtomicReadByteArrayOp_Int  -> \[r]   [a,i]         -> PrimInline . boundsCheckedLen bound a (byteIndex32 i) $ r |= read_i32 a i
+  AtomicWriteByteArrayOp_Int -> \[]    [a,i,v]       -> PrimInline . boundsCheckedLen bound a (byteIndex32 i) $ write_i32 a i v
+  FetchAddByteArrayOp_Int    -> \[r]   [a,i,v] -> PrimInline . boundsCheckedLen bound a (byteIndex32 i) $ fetchOpByteArray Add  r a i v
+  FetchSubByteArrayOp_Int    -> \[r]   [a,i,v] -> PrimInline . boundsCheckedLen bound a (byteIndex32 i) $ fetchOpByteArray Sub  r a i v
+  FetchAndByteArrayOp_Int    -> \[r]   [a,i,v] -> PrimInline . boundsCheckedLen bound a (byteIndex32 i) $ fetchOpByteArray BAnd r a i v
+  FetchOrByteArrayOp_Int     -> \[r]   [a,i,v] -> PrimInline . boundsCheckedLen bound a (byteIndex32 i) $ fetchOpByteArray BOr  r a i v
+  FetchNandByteArrayOp_Int   -> \[r]   [a,i,v] -> PrimInline . boundsCheckedLen bound a (byteIndex32 i) $ fetchOpByteArray (\x y -> BNot (BAnd x y)) r a i v
+  FetchXorByteArrayOp_Int    -> \[r]   [a,i,v] -> PrimInline . boundsCheckedLen bound a (byteIndex32 i) $ fetchOpByteArray BXor r a i v
 
 ------------------------------- Addr# ------------------------------------------
 
@@ -1031,115 +1032,115 @@ genPrim prof bound ty op = case op of
   TraceEventBinaryOp -> \[] [ed,eo,len] -> PrimInline $ appS "h$traceEventBinary" [ed,eo,len]
   TraceMarkerOp      -> \[] [ed,eo]     -> PrimInline $ appS "h$traceMarker" [ed,eo]
 
-  IndexByteArrayOp_Word8AsChar      -> \[r] [a,i] -> PrimInline . boundsChecked bound a i         $ r |= read_boff_u8  a i
-  IndexByteArrayOp_Word8AsWideChar  -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_boff_i32 a i
+  IndexByteArrayOp_Word8AsChar      -> \[r] [a,i] -> PrimInline . boundsCheckedLen bound a i         $ r |= read_boff_u8  a i
+  IndexByteArrayOp_Word8AsWideChar  -> \[r] [a,i] -> PrimInline . boundsCheckedLen bound a i . boundsCheckedLen bound a (Add i 3) $ r |= read_boff_i32 a i
   IndexByteArrayOp_Word8AsAddr      -> \[r1,r2] [a,i] ->
       PrimInline $ jVar \x -> mconcat
         [ x |= i .<<. two_
-        , boundsChecked bound (a .^ "arr") x $
+        , boundsCheckedLen bound (a .^ "arr") x $
           ifS (a .^ "arr" .&&. a .^ "arr" .! x)
                (mconcat [ r1 |= a .^ "arr" .! x .! zero_
                         , r2 |= a .^ "arr" .! x .! one_
                         ])
                (mconcat [r1 |= null_, r2 |= one_])
         ]
-  IndexByteArrayOp_Word8AsFloat     -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_boff_f32 a i
-  IndexByteArrayOp_Word8AsDouble    -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 7) $ r |= read_boff_f64 a i
+  IndexByteArrayOp_Word8AsFloat     -> \[r] [a,i] -> PrimInline . boundsCheckedLen bound a i . boundsCheckedLen bound a (Add i 3) $ r |= read_boff_f32 a i
+  IndexByteArrayOp_Word8AsDouble    -> \[r] [a,i] -> PrimInline . boundsCheckedLen bound a i . boundsCheckedLen bound a (Add i 7) $ r |= read_boff_f64 a i
   IndexByteArrayOp_Word8AsStablePtr -> \[r1,r2] [a,i] ->
     PrimInline $ mconcat
     [ r1 |= var "h$stablePtrBuf"
     , r2 |= read_boff_i32 a i
     ]
-  IndexByteArrayOp_Word8AsInt16     -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 1) $ r |= read_boff_i16 a i
-  IndexByteArrayOp_Word8AsInt32     -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_boff_i32 a i
+  IndexByteArrayOp_Word8AsInt16     -> \[r] [a,i] -> PrimInline . boundsCheckedLen bound a i . boundsCheckedLen bound a (Add i 1) $ r |= read_boff_i16 a i
+  IndexByteArrayOp_Word8AsInt32     -> \[r] [a,i] -> PrimInline . boundsCheckedLen bound a i . boundsCheckedLen bound a (Add i 3) $ r |= read_boff_i32 a i
   IndexByteArrayOp_Word8AsInt64     -> \[h,l] [a,i] ->
     PrimInline $ mconcat
         [ h |= read_boff_i32 a (Add i (Int 4))
         , l |= read_boff_u32 a i
         ]
-  IndexByteArrayOp_Word8AsInt       -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_boff_i32  a i
-  IndexByteArrayOp_Word8AsWord16    -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 1) $ r |= read_boff_u16  a i
-  IndexByteArrayOp_Word8AsWord32    -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_boff_u32  a i
+  IndexByteArrayOp_Word8AsInt       -> \[r] [a,i] -> PrimInline . boundsCheckedLen bound a i . boundsCheckedLen bound a (Add i 3) $ r |= read_boff_i32  a i
+  IndexByteArrayOp_Word8AsWord16    -> \[r] [a,i] -> PrimInline . boundsCheckedLen bound a i . boundsCheckedLen bound a (Add i 1) $ r |= read_boff_u16  a i
+  IndexByteArrayOp_Word8AsWord32    -> \[r] [a,i] -> PrimInline . boundsCheckedLen bound a i . boundsCheckedLen bound a (Add i 3) $ r |= read_boff_u32  a i
   IndexByteArrayOp_Word8AsWord64    -> \[h,l] [a,i] ->
-    PrimInline . boundsChecked bound a (Add i 7) $ mconcat
+    PrimInline . boundsCheckedLen bound a i . boundsCheckedLen bound a (Add i 7) $ mconcat
         [ h |= read_boff_u32 a (Add i (Int 4))
         , l |= read_boff_u32 a i
         ]
-  IndexByteArrayOp_Word8AsWord      -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_boff_u32  a i
+  IndexByteArrayOp_Word8AsWord      -> \[r] [a,i] -> PrimInline . boundsCheckedLen bound a i . boundsCheckedLen bound a (Add i 3) $ r |= read_boff_u32  a i
 
-  ReadByteArrayOp_Word8AsChar       -> \[r] [a,i] -> PrimInline . boundsChecked bound a i         $ r |= read_boff_u8  a i
-  ReadByteArrayOp_Word8AsWideChar   -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_boff_i32 a i
+  ReadByteArrayOp_Word8AsChar       -> \[r] [a,i] -> PrimInline . boundsCheckedLen bound a i               $ r |= read_boff_u8  a i
+  ReadByteArrayOp_Word8AsWideChar   -> \[r] [a,i] -> PrimInline . boundsCheckedLen bound a i . boundsCheckedLen bound a (Add i 3) $ r |= read_boff_i32 a i
   ReadByteArrayOp_Word8AsAddr       -> \[r1,r2] [a,i] ->
       PrimInline $ jVar \x -> mconcat
         [ x |= i .<<. two_
-        , boundsChecked bound (a .^ "arr") x $
+        , boundsCheckedLen bound (a .^ "arr") x $
           ifS (a .^ "arr" .&&. a .^ "arr" .! x)
                (mconcat [ r1 |= a .^ "arr" .! x .! zero_
                         , r2 |= a .^ "arr" .! x .! one_
                         ])
                (mconcat [r1 |= null_, r2 |= one_])
         ]
-  ReadByteArrayOp_Word8AsFloat      -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_boff_f32 a i
-  ReadByteArrayOp_Word8AsDouble     -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 7) $ r |= read_boff_f64 a i
+  ReadByteArrayOp_Word8AsFloat      -> \[r] [a,i] -> PrimInline . boundsCheckedLen bound a i . boundsCheckedLen bound a (Add i 3) $ r |= read_boff_f32 a i
+  ReadByteArrayOp_Word8AsDouble     -> \[r] [a,i] -> PrimInline . boundsCheckedLen bound a i . boundsCheckedLen bound a (Add i 7) $ r |= read_boff_f64 a i
   ReadByteArrayOp_Word8AsStablePtr  -> \[r1,r2] [a,i] ->
     PrimInline $ mconcat
     [ r1 |= var "h$stablePtrBuf"
     , r2 |= read_boff_i32 a i
     ]
-  ReadByteArrayOp_Word8AsInt16      -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 1) $ r |= read_boff_i16 a i
-  ReadByteArrayOp_Word8AsInt32      -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_boff_i32 a i
+  ReadByteArrayOp_Word8AsInt16      -> \[r] [a,i] -> PrimInline . boundsCheckedLen bound a i . boundsCheckedLen bound a (Add i 1) $ r |= read_boff_i16 a i
+  ReadByteArrayOp_Word8AsInt32      -> \[r] [a,i] -> PrimInline . boundsCheckedLen bound a i . boundsCheckedLen bound a (Add i 3) $ r |= read_boff_i32 a i
   ReadByteArrayOp_Word8AsInt64      -> \[h,l] [a,i] ->
     PrimInline $ mconcat
       [ h |= read_boff_i32 a (Add i (Int 4))
       , l |= read_boff_u32 a i
       ]
-  ReadByteArrayOp_Word8AsInt        -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_boff_i32  a i
-  ReadByteArrayOp_Word8AsWord16     -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 1) $ r |= read_boff_u16  a i
-  ReadByteArrayOp_Word8AsWord32     -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_boff_u32  a i
+  ReadByteArrayOp_Word8AsInt        -> \[r] [a,i] -> PrimInline . boundsCheckedLen bound a i . boundsCheckedLen bound a (Add i 3) $ r |= read_boff_i32  a i
+  ReadByteArrayOp_Word8AsWord16     -> \[r] [a,i] -> PrimInline . boundsCheckedLen bound a i . boundsCheckedLen bound a (Add i 1) $ r |= read_boff_u16  a i
+  ReadByteArrayOp_Word8AsWord32     -> \[r] [a,i] -> PrimInline . boundsCheckedLen bound a i . boundsCheckedLen bound a (Add i 3) $ r |= read_boff_u32  a i
   ReadByteArrayOp_Word8AsWord64     -> \[h,l] [a,i] ->
-    PrimInline . boundsChecked bound a (Add i 7) $ mconcat
+    PrimInline . boundsCheckedLen bound a i . boundsCheckedLen bound a (Add i 7) $ mconcat
         [ h |= read_boff_u32 a (Add i (Int 4))
         , l |= read_boff_u32 a i
         ]
-  ReadByteArrayOp_Word8AsWord       -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_boff_u32  a i
+  ReadByteArrayOp_Word8AsWord       -> \[r] [a,i] -> PrimInline . boundsCheckedLen bound a i . boundsCheckedLen bound a (Add i 3) $ r |= read_boff_u32  a i
 
-  WriteByteArrayOp_Word8AsChar      -> \[] [a,i,e] -> PrimInline . boundsChecked bound a i         $ write_boff_i8  a i e
-  WriteByteArrayOp_Word8AsWideChar  -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 3) $ write_boff_i32 a i e
+  WriteByteArrayOp_Word8AsChar      -> \[] [a,i,e] -> PrimInline . boundsCheckedLen bound a i               $ write_boff_i8  a i e
+  WriteByteArrayOp_Word8AsWideChar  -> \[] [a,i,e] -> PrimInline . boundsCheckedLen bound a i . boundsCheckedLen bound a (Add i 3) $ write_boff_i32 a i e
   WriteByteArrayOp_Word8AsAddr      -> \[] [a,i,e1,e2] ->
     PrimInline $ mconcat
       [ ifS (Not (a .^ "arr")) (a .^ "arr" |= ValExpr (JList [])) mempty
-      , boundsChecked bound (a .^ "arr") (i .<<. two_) $
+      , boundsCheckedLen bound (a .^ "arr") (i .<<. two_) $
           a .^ "arr" .! (i .<<. two_) |= ValExpr (JList [e1, e2])
       ]
 
-  WriteByteArrayOp_Word8AsFloat     -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 3) $ write_boff_f32 a i e
-  WriteByteArrayOp_Word8AsDouble    -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 7) $ write_boff_f64 a i e
-  WriteByteArrayOp_Word8AsStablePtr -> \[] [a,i,_e1,e2] -> PrimInline . boundsChecked bound a (Add i 3) $ write_boff_i32 a i e2
-  WriteByteArrayOp_Word8AsInt16     -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 1) $ write_boff_i16 a i e
-  WriteByteArrayOp_Word8AsInt32     -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 3) $ write_boff_i32 a i e
+  WriteByteArrayOp_Word8AsFloat     -> \[] [a,i,e] -> PrimInline . boundsCheckedLen bound a i . boundsCheckedLen bound a (Add i 3) $ write_boff_f32 a i e
+  WriteByteArrayOp_Word8AsDouble    -> \[] [a,i,e] -> PrimInline . boundsCheckedLen bound a i . boundsCheckedLen bound a (Add i 7) $ write_boff_f64 a i e
+  WriteByteArrayOp_Word8AsStablePtr -> \[] [a,i,_e1,e2] -> PrimInline . boundsCheckedLen bound a i . boundsCheckedLen bound a (Add i 3) $ write_boff_i32 a i e2
+  WriteByteArrayOp_Word8AsInt16     -> \[] [a,i,e] -> PrimInline . boundsCheckedLen bound a i . boundsCheckedLen bound a (Add i 1) $ write_boff_i16 a i e
+  WriteByteArrayOp_Word8AsInt32     -> \[] [a,i,e] -> PrimInline . boundsCheckedLen bound a i . boundsCheckedLen bound a (Add i 3) $ write_boff_i32 a i e
   WriteByteArrayOp_Word8AsInt64     -> \[] [a,i,h,l] ->
     -- JS Numbers are little-endian and 32-bit, so write the lower 4 bytes at i
     -- then write the higher 4 bytes to i+4
-    PrimInline . boundsChecked bound a i
+    PrimInline . boundsCheckedLen bound a i
                $ mconcat [ write_boff_i32 a (Add i (Int 4)) h
                          , write_boff_u32 a i               l
                          ]
-  WriteByteArrayOp_Word8AsInt       -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 3) $ write_boff_i32 a i e
-  WriteByteArrayOp_Word8AsWord16    -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 1) $ write_boff_u16 a i e
-  WriteByteArrayOp_Word8AsWord32    -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 3) $ write_boff_u32 a i e
+  WriteByteArrayOp_Word8AsInt       -> \[] [a,i,e] -> PrimInline . boundsCheckedLen bound a i . boundsCheckedLen bound a (Add i 3) $ write_boff_i32 a i e
+  WriteByteArrayOp_Word8AsWord16    -> \[] [a,i,e] -> PrimInline . boundsCheckedLen bound a i . boundsCheckedLen bound a (Add i 1) $ write_boff_u16 a i e
+  WriteByteArrayOp_Word8AsWord32    -> \[] [a,i,e] -> PrimInline . boundsCheckedLen bound a i . boundsCheckedLen bound a (Add i 3) $ write_boff_u32 a i e
   WriteByteArrayOp_Word8AsWord64    -> \[] [a,i,h,l] ->
-    PrimInline . boundsChecked bound a (Add i 7)
+    PrimInline . boundsCheckedLen bound a i . boundsCheckedLen bound a (Add i 7)
                $ mconcat [ write_boff_u32 a  (Add i (Int 4)) h
                          , write_boff_u32 a  i               l
                          ]
-  WriteByteArrayOp_Word8AsWord      -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 3) $ write_boff_u32 a i e
+  WriteByteArrayOp_Word8AsWord      -> \[] [a,i,e] -> PrimInline . boundsCheckedLen bound a i . boundsCheckedLen bound a (Add i 3) $ write_boff_u32 a i e
 
-  CasByteArrayOp_Int                -> \[r] [a,i,old,new] -> PrimInline . boundsChecked bound a (Add i 3) $ casOp read_i32 write_i32 r a i old new
-  CasByteArrayOp_Int8               -> \[r] [a,i,old,new] -> PrimInline . boundsChecked bound a i         $ casOp read_i8  write_i8  r a i old new
-  CasByteArrayOp_Int16              -> \[r] [a,i,old,new] -> PrimInline . boundsChecked bound a (Add i 1) $ casOp read_i16 write_i16 r a i old new
-  CasByteArrayOp_Int32              -> \[r] [a,i,old,new] -> PrimInline . boundsChecked bound a (Add i 3) $ casOp read_i32 write_i32 r a i old new
+  CasByteArrayOp_Int                -> \[r] [a,i,old,new] -> PrimInline . boundsCheckedLen bound a (byteIndex32 i) $ casOp read_i32 write_i32 r a i old new
+  CasByteArrayOp_Int8               -> \[r] [a,i,old,new] -> PrimInline . boundsCheckedLen bound a i               $ casOp read_i8  write_i8  r a i old new
+  CasByteArrayOp_Int16              -> \[r] [a,i,old,new] -> PrimInline . boundsCheckedLen bound a (byteIndex16 i) $ casOp read_i16 write_i16 r a i old new
+  CasByteArrayOp_Int32              -> \[r] [a,i,old,new] -> PrimInline . boundsCheckedLen bound a (byteIndex32 i) $ casOp read_i32 write_i32 r a i old new
 
-  CasByteArrayOp_Int64              -> \[r_h,r_l] [a,i,old_h,old_l,new_h,new_l] -> PrimInline . boundsChecked bound a (Add (i .<<. one_) one_) $
+  CasByteArrayOp_Int64              -> \[r_h,r_l] [a,i,old_h,old_l,new_h,new_l] -> PrimInline . boundsCheckedLen bound a (Add (i .<<. one_) one_) $
     jVar \t_h t_l -> mconcat [ t_h |= read_i32 a (Add (i .<<. one_) one_)
                              , t_l |= read_u32 a (i .<<. one_)
                              , r_h |= t_h
@@ -1466,17 +1467,76 @@ newByteArray :: JExpr -> JExpr -> JStat
 newByteArray tgt len =
   tgt |= app "h$newByteArray" [len]
 
-boundsChecked :: Bool  -- ^ Should we do bounds checking?
-              -> JExpr -- ^ Array
-              -> JExpr -- ^ Index
-              -> JStat -- ^ Result
-              -> JStat
-boundsChecked False _ _ r = r
-boundsChecked True  xs i r =
-  ifS ((i .<. xs .^ "length") .&&. (i .>=. zero_))
+boundsChecked'
+  :: JExpr -- ^ Max index expression
+  -> Bool  -- ^ Should we do bounds checking?
+  -> JExpr -- ^ Index
+  -> JStat -- ^ Result
+  -> JStat
+boundsChecked' _         False _ r = r
+boundsChecked' max_index True  i r =
+  ifS ((i .>=. zero_) .&&. (i .<. max_index)) r $
+    returnS (app "h$exitProcess" [Int 134])
+
+-- | Bounds checking using ".length" property (Arrays)
+boundsChecked
+  :: Bool  -- ^ Should we do bounds checking?
+  -> JExpr -- ^ Array
+  -> JExpr -- ^ Index
+  -> JStat -- ^ Result
+  -> JStat
+boundsChecked do_check arr = boundsChecked' (arr .^ "length") do_check
+
+-- | Bounds checking using ".len" property (ByteArrays)
+boundsCheckedLen
+  :: Bool  -- ^ Should we do bounds checking?
+  -> JExpr -- ^ Array
+  -> JExpr -- ^ Index
+  -> JStat -- ^ Result
+  -> JStat
+boundsCheckedLen do_check arr = boundsChecked' (arr .^ "len") do_check
+
+-- | Bounds checking on a range and using ".len" property (ByteArrays)
+--
+-- Empty ranges trivially pass the check
+boundsCheckedRangeLen
+  :: Bool  -- ^ Should we do bounds checking?
+  -> JExpr -- ^ Array
+  -> JExpr -- ^ Index
+  -> JExpr -- ^ Range size
+  -> JStat -- ^ Result
+  -> JStat
+boundsCheckedRangeLen False _  _ _ r = r
+boundsCheckedRangeLen True  xs i n r =
+  ifS (n .<. zero_) (returnS $ app "h$exitProcess" [Int 134]) $
+  ifS (n .===. zero_) -- We can always fill zero elements, even if it seems out-of-bounds
+      r
+      (boundsCheckedLen True xs (Add i (Sub n 1)) (boundsCheckedLen True xs i r))
+
+checkOverlapByteArray
+  :: Bool  -- ^ Should we do bounds checking?
+  -> JExpr -- ^ First array
+  -> JExpr -- ^ First offset
+  -> JExpr -- ^ Second array
+  -> JExpr -- ^ Second offset
+  -> JExpr -- ^ Range size
+  -> JStat -- ^ Result
+  -> JStat
+checkOverlapByteArray False _ _ _ _ _ r = r
+checkOverlapByteArray True a1 o1 a2 o2 n r =
+  ifS (app "h$checkOverlapByteArray" [a1, o1, a2, o2, n])
     r
     (returnS $ app "h$exitProcess" [Int 134])
 
+byteIndex16 :: JExpr -> JExpr
+byteIndex16 i = Add 1 (Mul 2 i)
+
+byteIndex32 :: JExpr -> JExpr
+byteIndex32 i = Add 3 (Mul 4 i)
+
+byteIndex64 :: JExpr -> JExpr
+byteIndex64 i = Add 7 (Mul 8 i)
+
 -- e|0 (32 bit signed integer truncation) required because of JS numbers. e|0
 -- converts e to an Int32. Note that e|0 _is still a Double_ because JavaScript.
 -- So (x|0) * (y|0) can still return values outside of the Int32 range. You have
diff --git a/rts/js/mem.js b/rts/js/mem.js
index 2f91b80798..73e6f9aecd 100644
--- a/rts/js/mem.js
+++ b/rts/js/mem.js
@@ -1455,3 +1455,15 @@ function h$pext64(src_b, src_a, mask_b, mask_a) {
  }
  RETURN_UBX_TUP2(dst_b, dst_a);
 }
+
+function h$checkOverlapByteArray(a1, o1, a2, o2, n) {
+  if (n == 0) return true;
+  if (a1 == a2) {
+    if (o1 < o2) {
+      return o1 + n - 1 < o2;
+    } else {
+      return o2 + n - 1 < o1;
+    }
+  }
+  return true;
+}
diff --git a/testsuite/tests/codeGen/should_fail/all.T b/testsuite/tests/codeGen/should_fail/all.T
index 60e863663a..91f86b16ad 100644
--- a/testsuite/tests/codeGen/should_fail/all.T
+++ b/testsuite/tests/codeGen/should_fail/all.T
@@ -24,4 +24,3 @@ check_bounds_test('CheckBoundsCompareByteArray2') # Check first byte, 1st array
 check_bounds_test('CheckBoundsCompareByteArray3') # Check negative length
 check_bounds_test('CheckOverlapCopyByteArray')
 check_bounds_test('CheckOverlapCopyAddrToByteArray')
-
diff --git a/testsuite/tests/codeGen/should_run/all.T b/testsuite/tests/codeGen/should_run/all.T
index 2fed5e0a5c..ae42db9eef 100644
--- a/testsuite/tests/codeGen/should_run/all.T
+++ b/testsuite/tests/codeGen/should_run/all.T
@@ -229,4 +229,4 @@ test('T20640b', normal, compile_and_run, [''])
 test('T22296',[only_ways(llvm_ways)
               ,unless(arch('x86_64'), skip)],compile_and_run,[''])
 test('T22798', normal, compile_and_run, ['-fregs-graph'])
-test('CheckBoundsOK', js_broken(23123), compile_and_run, ['-fcheck-prim-bounds'])
+test('CheckBoundsOK', js_broken(21142), compile_and_run, ['-fcheck-prim-bounds'])