rts: Add optional bounds checking in out-of-line primops

1 files changed, 18 insertions, 0 deletions

diff --git a/rts/PrimOps.cmm b/rts/PrimOps.cmm
index 0cb87242f6..edbd435702 100644
--- a/rts/PrimOps.cmm
+++ b/rts/PrimOps.cmm
@@ -40,6 +40,13 @@ import CLOSURE ghczmprim_GHCziTypes_False_closure;
 import CLOSURE CCS_MAIN;
 #endif
 
+#if defined(DEBUG)
+#define ASSERT_IN_BOUNDS(ind, sz) \
+    if (ind >= sz) { ccall rtsOutOfBoundsAccess(); }
+#else
+#define ASSERT_IN_BOUNDS(ind, sz)
+#endif
+
 /*-----------------------------------------------------------------------------
   Array Primitives
 
@@ -257,6 +264,7 @@ stg_casIntArrayzh( gcptr arr, W_ ind, W_ old, W_ new )
 {
     W_ p, h;
 
+    ASSERT_IN_BOUNDS(ind + WDS(1) - 1, StgArrBytes_bytes(arr));
     p = arr + SIZEOF_StgArrBytes + WDS(ind);
     (h) = prim %cmpxchgW(p, old, new);
 
@@ -270,6 +278,7 @@ stg_casInt8Arrayzh( gcptr arr, W_ ind, I8 old, I8 new )
     W_ p;
     I8 h;
 
+    ASSERT_IN_BOUNDS(ind, StgArrBytes_bytes(arr));
     p = arr + SIZEOF_StgArrBytes + ind;
     (h) = prim %cmpxchg8(p, old, new);
 
@@ -283,6 +292,7 @@ stg_casInt16Arrayzh( gcptr arr, W_ ind, I16 old, I16 new )
     W_ p;
     I16 h;
 
+    ASSERT_IN_BOUNDS(ind + 1, StgArrBytes_bytes(arr));
     p = arr + SIZEOF_StgArrBytes + ind*2;
     (h) = prim %cmpxchg16(p, old, new);
 
@@ -296,6 +306,7 @@ stg_casInt32Arrayzh( gcptr arr, W_ ind, I32 old, I32 new )
     W_ p;
     I32 h;
 
+    ASSERT_IN_BOUNDS(ind + 3, StgArrBytes_bytes(arr));
     p = arr + SIZEOF_StgArrBytes + ind*4;
     (h) = prim %cmpxchg32(p, old, new);
 
@@ -309,6 +320,7 @@ stg_casInt64Arrayzh( gcptr arr, W_ ind, I64 old, I64 new )
     W_ p;
     I64 h;
 
+    ASSERT_IN_BOUNDS(ind + 7, StgArrBytes_bytes(arr));
     p = arr + SIZEOF_StgArrBytes + ind*8;
     (h) = prim %cmpxchg64(p, old, new);
 
@@ -417,6 +429,7 @@ stg_casArrayzh ( gcptr arr, W_ ind, gcptr old, gcptr new )
     gcptr h;
     W_ p, len;
 
+    ASSERT_IN_BOUNDS(ind, StgMutArrPtrs_ptrs(arr));
     p = arr + SIZEOF_StgMutArrPtrs + WDS(ind);
     (h) = prim %cmpxchgW(p, old, new);
 
@@ -580,6 +593,8 @@ stg_copySmallArrayzh ( gcptr src, W_ src_off, gcptr dst, W_ dst_off, W_ n)
 
         SET_INFO(dst, stg_SMALL_MUT_ARR_PTRS_DIRTY_info);
 
+        ASSERT_IN_BOUNDS(dst_off + n - 1, StgSmallMutArrPtrs_ptrs(dst));
+        ASSERT_IN_BOUNDS(src_off + n - 1, StgSmallMutArrPtrs_ptrs(src));
         dst_p = dst + SIZEOF_StgSmallMutArrPtrs + WDS(dst_off);
         src_p = src + SIZEOF_StgSmallMutArrPtrs + WDS(src_off);
         bytes = WDS(n);
@@ -601,6 +616,8 @@ stg_copySmallMutableArrayzh ( gcptr src, W_ src_off, gcptr dst, W_ dst_off, W_ n
 
         SET_INFO(dst, stg_SMALL_MUT_ARR_PTRS_DIRTY_info);
 
+        ASSERT_IN_BOUNDS(dst_off + n - 1, StgSmallMutArrPtrs_ptrs(dst));
+        ASSERT_IN_BOUNDS(src_off + n - 1, StgSmallMutArrPtrs_ptrs(src));
         dst_p = dst + SIZEOF_StgSmallMutArrPtrs + WDS(dst_off);
         src_p = src + SIZEOF_StgSmallMutArrPtrs + WDS(src_off);
         bytes = WDS(n);
@@ -621,6 +638,7 @@ stg_casSmallArrayzh ( gcptr arr, W_ ind, gcptr old, gcptr new )
     gcptr h;
     W_ p, len;
 
+    ASSERT_IN_BOUNDS(ind, StgSmallMutArrPtrs_ptrs(arr));
     p = arr + SIZEOF_StgSmallMutArrPtrs + WDS(ind);
     (h) = prim %cmpxchgW(p, old, new);