From e754ff7f178a629a2261cba77a29d9510391aebd Mon Sep 17 00:00:00 2001
From: Moritz Angermann <moritz.angermann@gmail.com>
Date: Sat, 13 Feb 2021 16:44:19 +0800
Subject: Allocate Adjustors and mark them readable in two steps

This drops allocateExec for darwin, and replaces it with
a alloc, write, mark executable strategy instead. This prevents
us from trying to allocate an executable range and then write to
it, which X^W will prohibit on darwin.

This will *only* work if we can use mmap.
---
 libraries/base/base.cabal         |  2 +-
 libraries/ghci/GHCi/InfoTable.hsc | 18 ++++++++++++++++++
 libraries/ghci/ghci.cabal.in      |  1 +
 3 files changed, 20 insertions(+), 1 deletion(-)

(limited to 'libraries')

diff --git a/libraries/base/base.cabal b/libraries/base/base.cabal
index 530e0503c0..8d7460e7c4 100644
--- a/libraries/base/base.cabal
+++ b/libraries/base/base.cabal
@@ -87,7 +87,7 @@ Library
         Unsafe
 
     build-depends:
-        rts == 1.0,
+        rts == 1.0.*,
         ghc-prim >= 0.5.1.0 && < 0.9,
         ghc-bignum >= 1.0 && < 2.0
 
diff --git a/libraries/ghci/GHCi/InfoTable.hsc b/libraries/ghci/GHCi/InfoTable.hsc
index 2fe35ee927..fce2c653f2 100644
--- a/libraries/ghci/GHCi/InfoTable.hsc
+++ b/libraries/ghci/GHCi/InfoTable.hsc
@@ -318,7 +318,11 @@ sizeOfEntryCode tables_next_to_code
 -- Note: Must return proper pointer for use in a closure
 newExecConItbl :: Bool -> StgInfoTable -> ByteString -> IO (FunPtr ())
 newExecConItbl tables_next_to_code obj con_desc
+#if RTS_LINKER_USE_MMAP && MIN_VERSION_rts(1,0,1)
+   = do
+#else
    = alloca $ \pcode -> do
+#endif
         sz0 <- sizeOfEntryCode tables_next_to_code
         let lcon_desc = BS.length con_desc + 1{- null terminator -}
             -- SCARY
@@ -328,8 +332,13 @@ newExecConItbl tables_next_to_code obj con_desc
                -- table, because on a 64-bit platform we reference this string
                -- with a 32-bit offset relative to the info table, so if we
                -- allocated the string separately it might be out of range.
+#if RTS_LINKER_USE_MMAP && MIN_VERSION_rts(1,0,1)
+        wr_ptr <- _allocateWrite (sz + fromIntegral lcon_desc)
+        let ex_ptr = wr_ptr
+#else
         wr_ptr <- _allocateExec (sz + fromIntegral lcon_desc) pcode
         ex_ptr <- peek pcode
+#endif
         let cinfo = StgConInfoTable { conDesc = ex_ptr `plusPtr` fromIntegral sz
                                     , infoTable = obj }
         pokeConItbl tables_next_to_code wr_ptr ex_ptr cinfo
@@ -338,6 +347,9 @@ newExecConItbl tables_next_to_code obj con_desc
         let null_off = fromIntegral sz + fromIntegral (BS.length con_desc)
         poke (castPtr wr_ptr `plusPtr` null_off) (0 :: Word8)
         _flushExec sz ex_ptr -- Cache flush (if needed)
+#if RTS_LINKER_USE_MMAP && MIN_VERSION_rts(1,0,1)
+        _markExec (sz + fromIntegral lcon_desc) ex_ptr
+#endif
         pure $ if tables_next_to_code
           then castPtrToFunPtr $ ex_ptr `plusPtr` conInfoTableSizeB
           else castPtrToFunPtr ex_ptr
@@ -348,6 +360,12 @@ foreign import ccall unsafe "allocateExec"
 foreign import ccall unsafe "flushExec"
   _flushExec :: CUInt -> Ptr a -> IO ()
 
+#if RTS_LINKER_USE_MMAP && MIN_VERSION_rts(1,0,1)
+foreign import ccall unsafe "allocateWrite"
+  _allocateWrite :: CUInt -> IO (Ptr a)
+foreign import ccall unsafe "markExec"
+  _markExec :: CUInt -> Ptr a -> IO ()
+#endif
 -- -----------------------------------------------------------------------------
 -- Constants and config
 
diff --git a/libraries/ghci/ghci.cabal.in b/libraries/ghci/ghci.cabal.in
index ffba9d670b..e9922ab24a 100644
--- a/libraries/ghci/ghci.cabal.in
+++ b/libraries/ghci/ghci.cabal.in
@@ -70,6 +70,7 @@ library
         GHCi.TH.Binary
 
     Build-Depends:
+        rts,
         array            == 0.5.*,
         base             >= 4.8 && < 4.17,
         ghc-prim         >= 0.5.0 && < 0.9,
-- 
cgit v1.2.1