compiler/GHC/Builtin/primops.txt.pp

@@ -1852,6 +1852,70 @@ section "Byte Arrays"
 
 ------------------------------------------------------------------------
 
+-- Note [Byte arrays outside of the HEAP_ALLOCED space]
+-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+--
+-- It is useful to be able to allocate byte arrays outside of the heap,
+-- i.e. outside of the memory space covered by the HEAP_ALLOCED() test.
+--
+-- There are two major use cases (see issue #17747):
+--
+--  1. Having foreign memory appear as a normal GHC byte array. This
+--     are use cases similar to the use of a ForeignPtr, but where it
+--     is useful to have the representation be a byte array type, for
+--     easier interoperability with existing libraries.
+--
+--  2. Static byte arrays in object files for constant values.
+--
+-- The second is not yet available as it requires additional support
+-- from the code gen.
+--
+-- An example of the first category can be seen in GHC test T17747.
+-- A concrete use-case is to memory map a file
+-- but have it appear as a ByteArray# rather than a ForeignPtr. Doing
+-- so of course requires that space is reserved immediately before the
+-- file data for the byte array heap object header. See the
+-- placeByteArray# primop documentation below and the FFI section of
+-- the user guide for more details.
+--
+-- To have the first use-case work requires a few things:
+--
+-- * For the GC to not fail when it encounters byte arrays outside of
+--   the HEAP_ALLOCED space. This is straightforward because the GC
+--   has support for a number of different closure types to appear
+--   outside the heap (primarily for statically allocated values), and
+--   byte arrays are easy because they contain no heap pointers. See
+--   the reference back to this note in `evacuate(StgClosure **p)` in
+--   `rts/sm/Evac.c`
+--
+-- * For all other byte array primops (e.g. shrinkMutableByteArray#,
+--   sameMutableByteArray#, isByteArrayPinned#, etc.) to not fail when
+--   encountering byte arrays outside of the heap. Specifically
+--   isByteArrayPinned# requires special support. This is currently the
+--   only primop that needs special support.
+--   See Note [isByteArrayPinned# support for off heap byte arrays].
+--
+-- * A mechanism to set up the heap object header for a byte array at
+--   an address outside of the HEAP_ALLOCED space. This is needed to
+--   make the foreign allocated memory look like a byte array. This is
+--   provided by the placeByteArray# primop.
+--
+
+-- Note [isByteArrayPinned# support for off heap byte arrays]
+-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+-- The isByteArrayPinned# primop is implemented by reading block descriptor
+-- flags. Since off heap byte arrays don't have block descriptors,
+-- isByteArrayPinned# must explicitly check if the byte array is HEAP_ALLOCED
+-- or not. If not HEAP_ALLOCED then it is certainly pinned. This requires CMM
+-- support for the HEAP_ALLOCED test, which is otherwise only called from C
+-- code in the RTS. The current design is to provide full CMM
+-- implementations of HEAP_ALLOCED enabled in `rts/storage/HeapAlloc.h` with the
+-- CMINUSMINUS cpp flag. This includes HEAP_ALLOCED_CALLISH which essentially
+-- duplicates what is already a complex C implementation. This is fast
+-- but an alternative would be to use a CMM C call to a C function that use
+-- the existing C implementation of HEAP_ALLOCED.
+
+
 primtype ByteArray#
 {
   A boxed, unlifted datatype representing a region of raw memory in the garbage-collected heap,
@@ -1902,10 +1966,17 @@ primop  NewByteArrayOp_Char "newByteArray#" GenPrimOp
    with out_of_line = True
         effect = ReadWriteEffect
 
+-- See Note [Byte arrays outside of the HEAP_ALLOCED space]
 primop  PlaceByteArrayOp_Char "placeByteArray#" GenPrimOp
    Addr# -> Int# -> State# s -> (# State# s, MutableByteArray# s #)
-   {Place a new byte array header for the specified size (in bytes), at the
-    specified address outside of the heap, in the specified state thread.}
+   {Place a new byte array header at the specified address outside of the heap,
+   for the specified payload size (in bytes), in the specified state thread. In
+   C code with `#include "Rts.h"`, use `sizeOf(StgArrBytes)` or
+   `sizeOfW(StgArrBytes)` to get the size of a byte array header in bytes or
+   words respectively. The caller must ensure `sizeof(StgArrBytes) + n` bytes of
+   space is allocated at the give address for the heap object header followed by
+   n bytes of payload. See the FFI section of the user guide for more details
+   on how to use this primop.}
    with out_of_line = True
         effect = ReadWriteEffect
 

docs/users_guide/exts/ffi.rst

@@ -831,7 +831,7 @@ Note that the object header size is different for normal and profiling
 builds. When allocating in foreign memory, space must be made available
 for this in the memory layout immediately before the data payload.
 
-In C code, ``#include "rts.h"`` and use ``sizeOf(StgArrBytes)`` or
+In C code, ``#include "Rts.h"`` and use ``sizeOf(StgArrBytes)`` or
 ``sizeOfW(StgArrBytes)`` to get the size of a byte array heap object
 header in bytes or words respectively. This is the space that must be
 reserved at the memory location immediately before the intended payload.

rts/PrimOps.cmm

@@ -135,6 +135,7 @@ stg_newByteArrayzh ( W_ n )
 }
 
 stg_placeByteArrayzh ( W_ addr, W_ n )
+// Addr# -> Int# -> MutableByteArray# {
 {
     /* Place an ARR_WORDS object header at the given address outside the heap.
        The caller must arrange for space for the heap object header. */
@@ -148,6 +149,7 @@ stg_placeByteArrayzh ( W_ addr, W_ n )
 #define BA_ALIGN 16
 #define BA_MASK  (BA_ALIGN-1)
 
+// See Note [Byte arrays outside of the HEAP_ALLOCED space]
 stg_newPinnedByteArrayzh ( W_ n )
 {
     W_ words, bytes, payload_words;

rts/include/rts/storage/HeapAlloc.h

@@ -78,6 +78,8 @@ extern struct mblock_address_range mblock_address_space;
 
 #else /* defined(CMINUSMINUS) */
 
+/* See Note [Byte arrays outside of the HEAP_ALLOCED space] */
+
 import mblock_address_space;
 
 // We explicitly duplicate the bound checking implementation of `HEAP_ALLOCED` for performance
@@ -100,6 +102,8 @@ extern StgWord8 mblock_map[];
 
 #else /* defined(CMINUSMINUS) */
 
+/* See Note [Byte arrays outside of the HEAP_ALLOCED space] */
+
 import CLOSURE mblock_map;
 
 # define MBLOCK_MAP_ENTRY(p)    ((p) >> MBLOCK_SHIFT)
@@ -259,6 +263,8 @@ StgBool HEAP_ALLOCED_GC(const void *p)
 
 #else /* defined(CMINUSMINUS) */
 
+/* See Note [Byte arrays outside of the HEAP_ALLOCED space] */
+
 // This is a call to HEAP_ALLOCED C function defined above. That function is reified via the
 // Inlines.c file. Since the implementation that can't use USE_LARGE_ADDRESS_SPACE is big and
 // complicated we prevent duplicating it's logic. We define the interface to be used in a statement

rts/sm/Evac.c

@@ -741,6 +741,7 @@ loop:
       case CONSTR_0_1:
       case CONSTR_0_2:
       case CONSTR_NOCAF:
+      /* See Note [Byte arrays outside of the HEAP_ALLOCED space] */
       case ARR_WORDS:
           /* no need to put these on the static linked list, they don't need
            * to be scavenged.

testsuite/tests/interface-stability/base-exports.stdout

@@ -4223,6 +4223,7 @@ module GHC.Base where
   pext32# :: Word# -> Word# -> Word#
   pext64# :: Word64# -> Word64# -> Word64#
   pext8# :: Word# -> Word# -> Word#
+  placeByteArray# :: forall d. Addr# -> Int# -> State# d -> (# State# d, MutableByteArray# d #)
   plusAddr# :: Addr# -> Int# -> Addr#
   plusDoubleX2# :: DoubleX2# -> DoubleX2# -> DoubleX2#
   plusDoubleX4# :: DoubleX4# -> DoubleX4# -> DoubleX4#
@@ -6325,6 +6326,7 @@ module GHC.Exts where
   pext32# :: Word# -> Word# -> Word#
   pext64# :: Word64# -> Word64# -> Word64#
   pext8# :: Word# -> Word# -> Word#
+  placeByteArray# :: forall d. Addr# -> Int# -> State# d -> (# State# d, MutableByteArray# d #)
   plusAddr# :: Addr# -> Int# -> Addr#
   plusDoubleX2# :: DoubleX2# -> DoubleX2# -> DoubleX2#
   plusDoubleX4# :: DoubleX4# -> DoubleX4# -> DoubleX4#

testsuite/tests/interface-stability/base-exports.stdout-javascript-unknown-ghcjs

@@ -4223,6 +4223,7 @@ module GHC.Base where
   pext32# :: Word# -> Word# -> Word#
   pext64# :: Word64# -> Word64# -> Word64#
   pext8# :: Word# -> Word# -> Word#
+  placeByteArray# :: forall d. Addr# -> Int# -> State# d -> (# State# d, MutableByteArray# d #)
   plusAddr# :: Addr# -> Int# -> Addr#
   plusDoubleX2# :: DoubleX2# -> DoubleX2# -> DoubleX2#
   plusDoubleX4# :: DoubleX4# -> DoubleX4# -> DoubleX4#
@@ -6294,6 +6295,7 @@ module GHC.Exts where
   pext32# :: Word# -> Word# -> Word#
   pext64# :: Word64# -> Word64# -> Word64#
   pext8# :: Word# -> Word# -> Word#
+  placeByteArray# :: forall d. Addr# -> Int# -> State# d -> (# State# d, MutableByteArray# d #)
   plusAddr# :: Addr# -> Int# -> Addr#
   plusDoubleX2# :: DoubleX2# -> DoubleX2# -> DoubleX2#
   plusDoubleX4# :: DoubleX4# -> DoubleX4# -> DoubleX4#

testsuite/tests/interface-stability/base-exports.stdout-mingw32

@@ -4226,6 +4226,7 @@ module GHC.Base where
   pext32# :: Word# -> Word# -> Word#
   pext64# :: Word64# -> Word64# -> Word64#
   pext8# :: Word# -> Word# -> Word#
+  placeByteArray# :: forall d. Addr# -> Int# -> State# d -> (# State# d, MutableByteArray# d #)
   plusAddr# :: Addr# -> Int# -> Addr#
   plusDoubleX2# :: DoubleX2# -> DoubleX2# -> DoubleX2#
   plusDoubleX4# :: DoubleX4# -> DoubleX4# -> DoubleX4#
@@ -6474,6 +6475,7 @@ module GHC.Exts where
   pext32# :: Word# -> Word# -> Word#
   pext64# :: Word64# -> Word64# -> Word64#
   pext8# :: Word# -> Word# -> Word#
+  placeByteArray# :: forall d. Addr# -> Int# -> State# d -> (# State# d, MutableByteArray# d #)
   plusAddr# :: Addr# -> Int# -> Addr#
   plusDoubleX2# :: DoubleX2# -> DoubleX2# -> DoubleX2#
   plusDoubleX4# :: DoubleX4# -> DoubleX4# -> DoubleX4#

testsuite/tests/interface-stability/base-exports.stdout-ws-32

@@ -4223,6 +4223,7 @@ module GHC.Base where
   pext32# :: Word# -> Word# -> Word#
   pext64# :: Word64# -> Word64# -> Word64#
   pext8# :: Word# -> Word# -> Word#
+  placeByteArray# :: forall d. Addr# -> Int# -> State# d -> (# State# d, MutableByteArray# d #)
   plusAddr# :: Addr# -> Int# -> Addr#
   plusDoubleX2# :: DoubleX2# -> DoubleX2# -> DoubleX2#
   plusDoubleX4# :: DoubleX4# -> DoubleX4# -> DoubleX4#
@@ -6325,6 +6326,7 @@ module GHC.Exts where
   pext32# :: Word# -> Word# -> Word#
   pext64# :: Word64# -> Word64# -> Word64#
   pext8# :: Word# -> Word# -> Word#
+  placeByteArray# :: forall d. Addr# -> Int# -> State# d -> (# State# d, MutableByteArray# d #)
   plusAddr# :: Addr# -> Int# -> Addr#
   plusDoubleX2# :: DoubleX2# -> DoubleX2# -> DoubleX2#
   plusDoubleX4# :: DoubleX4# -> DoubleX4# -> DoubleX4#

testsuite/tests/rts/T17747.hs

@@ -15,33 +15,26 @@ import GHC.Exts
 import GHC.Base (IO(IO))
 
 
--- | Test that we can allocate 'ByteArray#'s outside of the @HEAP_ALLOCED()@
--- address space without upsetting the GC. To be extra sure we attach weak
--- pointers with C finalizers to the 'ByteArray#'s. We keep them alive and run
--- a major GC so that the GC has to trace the live 'ByteArray#'s.
+-- | Test that we can allocate 'ByteArray#'s outside of the @HEAP_ALLOCED()@ address space without
+-- upsetting the GC. To be extra sure we attach weak pointers with C finalizers to the
+-- 'ByteArray#'s. We keep them alive and run a major GC so that the GC has to trace the live
+-- 'ByteArray#'s.
 --
--- On older GHC versions this upsets the GC because it does not expect heap
--- objects with closure type @ARR_WORDS@ to exist outside the heap.
+-- On older GHC versions this upsets the GC because it does not expect heap objects with closure
+-- type @ARR_WORDS@ to exist outside the heap.
 --
 -- > internal error: evacuate(static): strange closure type 42
 --
--- Finally we allow everything to be GC'd again, and check that the C
--- finalizers did run.
+-- Finally we free the backing memory with `unsafeFreeByteArray`. Then we rerun the GC'd again.
+-- Note: When connecting finalizers they seem to fire on shutdown of the RTS not on a major GC
+-- invocation.
 --
 main :: IO ()
 main = do
     heapallocedTest
 
-    n1 <- getMallocByteArrayCount
-    putStrLn ("malloc_count  = " ++ show n1)
-
     bytearrayTest
 
-    -- check that all the C finalizers ran to free() the things we allocated
-    performMajorGC
-    n2 <- getMallocByteArrayCount
-    putStrLn ("malloc_count  = " ++ show n1)
-
 -- | This checks that the CMM impl of HEAP_ALLOCED matches the behaviour of
 -- the C version. This test lives here since the CMM HEAP_ALLOCED is used by
 -- the isByteArrayPinned# primop now that it supports byte arrays that are
@@ -55,40 +48,67 @@ heapallocedTest = do
     putStrLn ("HEAP_ALLOCED  = " ++ show same
                  ++ "\t(c_HEAP_ALLOCED ptr == cmm_HEAP_ALLOCED ptr)")
   where
-    addrs =
+    -- For values selected here see OSMem.c
+    heapLowerbound = 8 * (2^30) -- 8GB lower bound starting index of the heap
+    heapDefaultStart = 0x4200000000 -- > 32GB default starting address of the heap
+    heapSizes = [0 -- Check the heap lower starting bound
+                , 2^40, 2^38] -- Check the heap upper bounds at both 1TB and 1/4TB of virtual memory
+    addrs
+      -- Addresses around the start of the heap
+      = [heapStart + heapSize + offset
+          | heapStart <- [heapLowerbound, heapDefaultStart]
+          , heapSize <-  heapSizes
+          , offset <- [-1000..1000]] -- Area of the bounds check
       -- 2k address probes, appropriate to the address space
-      case sizeOf (nullPtr :: Ptr ()) of
+      ++ case sizeOf (nullPtr :: Ptr ()) of
         4 -> [0, 2^21 .. 2^32-1] -- 0 to 4Gb-1 in 2Mb jumps
         8 -> [0, 2^30 .. 2^41-1] -- 0 to 2Tb-1 in 1Gb jumps
         _ -> error "sizeOf ptr not 4 or 8"
 
 bytearrayTest :: IO ()
 bytearrayTest = do
+    printMallocCount "initial"
+
+    let byteLengths = [0..99]
 
     -- malloc() a bunch of ByteArray#s on the C heap
-    foreignBAs <- mapM newForeignHeapByteArray [0..99]
-    n1 <- getMallocByteArrayCount
-    putStrLn ("malloc_count  = " ++ show n1)
+    (foreignPtrs, foreignBAs) <- unzip <$> mapM newForeignHeapByteArray byteLengths
+    printMallocCount "alloced"
 
     -- allocate a bunch of ByteArray#s on the GHC heap
-    nativeBAs <- mapM newNativeHeapByteArray [0..99]
+    nativeBAs <- mapM newNativeHeapByteArray byteLengths
 
     -- as a sanity check compare them to each other
     let same = and (zipWith equalByteArrays foreignBAs nativeBAs)
     putStrLn ("arrays equal  = " ++ show same
                 ++ "\t(and (zipWith equalByteArrays foreignBAs nativeBAs))")
 
-    -- and test the isByteArrayPinned# primop on them all
-    let pinned = all isByteArrayPinned foreignBAs
-    putStrLn ("arrays pinned = " ++ show pinned
+    -- and test the isByteArrayPinned# primop on them foreign byte arrays
+    let pinnedForeign = all isByteArrayPinned foreignBAs
+    putStrLn ("arrays pinned = " ++ show pinnedForeign
                  ++ "\t(all isByteArrayPinned foreignBAs)")
 
+    -- and test the isByteArrayPinned# primop on them native byte arrays
+    let pinnedNative = all isByteArrayPinned nativeBAs
+    putStrLn ("arrays pinned = " ++ show pinnedNative
+                 ++ "\t(all isByteArrayPinned nativeBAs)")
+
     -- while they're still live, have the GC inspect them all
     performMajorGC
-    n2 <- getMallocByteArrayCount
-    putStrLn ("malloc_count  = " ++ show n2)
+    printMallocCount "alive"
     mapM_ touchByteArray foreignBAs
 
+    -- after they have been freed, have another GC run
+    mapM_ unsafeFreeByteArray foreignPtrs
+    -- WARNING: DO NOT USE `foreignPtrs` OR `foreignBAs` AFTER THIS POINT
+    -- We have released the memory backing the byte arrays
+    performMajorGC
+    printMallocCount "final"
+
+printMallocCount :: String -> IO ()
+printMallocCount phase = do
+    n <- getMallocByteArrayCount
+    putStrLn ("malloc_count  = " ++ show n ++ "\t" ++ phase)
 
 data ByteArray        = ByteArray ByteArray#
 data MutableByteArray = MutableByteArray (MutableByteArray# RealWorld)
@@ -98,12 +118,14 @@ newNativeHeapByteArray n = do
     mba <- newByteArray n
     fillAndFreezeByteArray mba n
 
-newForeignHeapByteArray :: Int -> IO ByteArray
+newForeignHeapByteArray :: Int -> IO (Ptr a, ByteArray)
 newForeignHeapByteArray n = do
+    -- mallocByteArray also allocates memory for the header of a ByteArray#
     ptr <- mallocByteArray (fromIntegral n)
+    -- placeByteArray# writes the ByteArray# header in this additionally allocated memory
     mba <- placeByteArray ptr n
-    addCFinalizerToByteArray mba freeByteArray ptr
-    fillAndFreezeByteArray mba n
+    ba  <- fillAndFreezeByteArray mba n
+    pure (ptr, ba)
 
 newByteArray :: Int -> IO MutableByteArray
 newByteArray  (I# n#) =
@@ -125,18 +147,6 @@ fillAndFreezeByteArray (MutableByteArray mba#) (I# n#) =
           case unsafeFreezeByteArray# mba# s1 of
             (# s2, ba# #) -> (# s2, ByteArray ba# #)
 
-addCFinalizerToByteArray :: MutableByteArray
-                         -> FunPtr (Ptr a -> IO ())
-                         -> Ptr a
-                         -> IO ()
-addCFinalizerToByteArray (MutableByteArray ba#) (FunPtr cfunptr#) (Ptr ptr#) =
-    IO $ \s0 ->
-      case mkWeakNoFinalizer# ba# () s0 of
-        (# s1, weak# #) ->
-          -- 0# flag here means don't pass any env ptr to the finalizer
-          case addCFinalizerToWeak# cfunptr# ptr# 0# nullAddr# weak# s1 of
-            (# s2, _success# #) -> (# s2, () #)
-
 touchByteArray :: ByteArray -> IO ()
 touchByteArray (ByteArray ba#) =
     IO $ \s0 ->
@@ -161,8 +171,8 @@ cmm_HEAP_ALLOCED (Ptr addr#) = I# (cmm_HEAP_ALLOCED# addr#)
 foreign import ccall unsafe "mallocByteArray"
   mallocByteArray :: CInt -> IO (Ptr a)
 
-foreign import ccall unsafe "&freeByteArray"
-  freeByteArray :: FunPtr (Ptr a -> IO ())
+foreign import ccall unsafe "unsafeFreeByteArray"
+  unsafeFreeByteArray :: Ptr a -> IO ()
 
 foreign import ccall unsafe "getMallocByteArrayCount"
   getMallocByteArrayCount :: IO CInt
@@ -172,4 +182,3 @@ foreign import ccall unsafe "c_HEAP_ALLOCED"
 
 foreign import prim "cmm_HEAP_ALLOCED"
   cmm_HEAP_ALLOCED# :: Addr# -> Int#
-

testsuite/tests/rts/T17747.stdout

 HEAP_ALLOCED  = True	(c_HEAP_ALLOCED ptr == cmm_HEAP_ALLOCED ptr)
-malloc_count  = 0
-malloc_count  = 100
+malloc_count  = 0	initial
+malloc_count  = 100	alloced
 arrays equal  = True	(and (zipWith equalByteArrays foreignBAs nativeBAs))
 arrays pinned = True	(all isByteArrayPinned foreignBAs)
-malloc_count  = 100
-malloc_count  = 0
+arrays pinned = False	(all isByteArrayPinned nativeBAs)
+malloc_count  = 100	alive
+malloc_count  = 0	final

testsuite/tests/rts/T17747_c.c

@@ -11,7 +11,7 @@ void *mallocByteArray (StgWord len)
   return malloc(sizeof(StgArrBytes) + len);
 }
 
-void freeByteArray (void *arr)
+void unsafeFreeByteArray (void *arr)
 {
     free(arr);
     malloc_count--;
@@ -26,4 +26,3 @@ int c_HEAP_ALLOCED(void * p)
 {
   return HEAP_ALLOCED(p);
 }
-