Commit e754ff7f authored by Moritz Angermann's avatar Moritz Angermann Committed by Marge Bot
Browse files

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.
parent 4421fb34
......@@ -248,10 +248,9 @@ unitHsLibs namever ways0 p = map (mkDynName . addSuffix . ST.unpack) (unitLibrar
-- This change elevates the need to add custom hooks
-- and handling specifically for the `rts` package for
-- example in ghc-cabal.
addSuffix rts@"HSrts" = rts ++ (expandTag rts_tag)
addSuffix rts@"HSrts-1.0"= rts ++ (expandTag rts_tag)
addSuffix other_lib = other_lib ++ (expandTag tag)
addSuffix rts@"HSrts" = rts ++ (expandTag rts_tag)
addSuffix rts@"HSrts-1.0.1" = rts ++ (expandTag rts_tag)
addSuffix other_lib = other_lib ++ (expandTag tag)
expandTag t | null t = ""
| otherwise = '_':t
......@@ -75,7 +75,7 @@ To see which packages are currently available, use the ``ghc-pkg list`` command:
pretty-1.0.1.0
process-1.0.1.1
random-1.0.0.1
rts-1.0
rts-1.0.1
syb-0.1.0.0
template-haskell-2.4.0.0
terminfo-0.3.1
......
......@@ -155,7 +155,7 @@ needRtsSymLinks stage rtsWays
prefix, versionlessPrefix :: String
versionlessPrefix = "libHSrts"
prefix = versionlessPrefix ++ "-1.0"
prefix = versionlessPrefix ++ "-1.0.1"
-- removeRtsDummyVersion "a/libHSrts-1.0-ghc1.2.3.4.so"
-- == "a/libHSrts-ghc1.2.3.4.so"
......
......@@ -29,6 +29,12 @@ extern "C" {
#include <windows.h>
#endif
#if defined(ios_HOST_OS) || defined(darwin_HOST_OS)
/* Inclusion of system headers usually requires _DARWIN_C_SOURCE on Mac OS X
* because of some specific defines like MMAP_ANON, MMAP_ANONYMOUS. */
#define _DARWIN_C_SOURCE 1
#endif
#if !defined(IN_STG_CODE)
#define IN_STG_CODE 0
#endif
......
......@@ -205,9 +205,15 @@ typedef void* AdjustorExecutable;
AdjustorWritable allocateExec(W_ len, AdjustorExecutable *exec_addr);
void flushExec(W_ len, AdjustorExecutable exec_addr);
#if (defined(arm_HOST_ARCH) || defined(aarch64_HOST_ARCH)) && (defined(ios_HOST_OS) || defined(darwin_HOST_OS))
#if defined(darwin_HOST_OS)
AdjustorWritable execToWritable(AdjustorExecutable exec);
#endif
#if RTS_LINKER_USE_MMAP
AdjustorWritable allocateWrite(W_ bytes);
void markExec(W_ bytes, AdjustorWritable writ);
void freeWrite(W_ bytes, AdjustorWritable writ);
#endif
void freeExec (AdjustorExecutable p);
// Used by GC checks in external .cmm code:
......
......@@ -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
......
......@@ -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
......
......@@ -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,
......
......@@ -1528,7 +1528,7 @@ preloadObjectFile (pathchar *path)
*
* See also the misalignment logic for darwin below.
*/
#if defined(ios_HOST_OS)
#if defined(darwin_HOST_OS)
image = mmapForLinker(fileSize, PROT_READ|PROT_WRITE, MAP_PRIVATE, fd, 0);
#else
image = mmapForLinker(fileSize, PROT_READ|PROT_WRITE|PROT_EXEC,
......
......@@ -13,6 +13,11 @@
#include "linker/M32Alloc.h"
#if RTS_LINKER_USE_MMAP
#if defined(ios_HOST_OS) || defined(darwin_HOST_OS)
/* Inclusion of system headers usually requires _DARWIN_C_SOURCE on Mac OS X
* because of some specific defines like MMAP_ANON, MMAP_ANONYMOUS. */
#define _DARWIN_C_SOURCE 1
#endif
#include <sys/mman.h>
#endif
......
......@@ -849,7 +849,7 @@ StgRun(StgFunPtr f, StgRegTable *basereg) {
".globl " STG_RETURN "\n\t"
THUMB_FUNC
#if !defined(ios_HOST_OS)
#if !(defined(ios_HOST_OS) || defined(darwin_HOST_OS))
".type " STG_RETURN ", %%function\n"
#endif
STG_RETURN ":\n\t"
......
......@@ -17,7 +17,7 @@
rts_dist_HC = $(GHC_STAGE1)
rts_INSTALL_INFO = rts
rts_VERSION = 1.0
rts_VERSION = 1.0.1
# Minimum supported Windows version.
# These numbers can be found at:
......
......@@ -5,7 +5,7 @@
#include "MachDeps.h"
name: rts
version: 1.0
version: 1.0.1
id: rts
key: rts
license: BSD-3-Clause
......
cabal-version: 3.0
name: rts
version: 1.0
version: 1.0.1
license: BSD-3-Clause
maintainer: glasgow-haskell-users@haskell.org
build-type: Simple
......
......@@ -11,6 +11,18 @@
*
* ---------------------------------------------------------------------------*/
#include <ghcconfig.h>
#if RTS_LINKER_USE_MMAP
/*
* On FreeBSD and Darwin, when _XOPEN_SOURCE is defined, MAP_ANONYMOUS is not
* exposed from <sys/mman.h>. Include <sys/mman.h> before "PosixSource.h".
*
* Alternatively, we could drop "PosixSource.h" from this file, but for just
* one non-POSIX macro, that seems a needless price to pay.
*/
#include <sys/mman.h>
#endif
#include "PosixSource.h"
#include "Rts.h"
......@@ -34,6 +46,10 @@
#include "Hash.h"
#endif
#if RTS_LINKER_USE_MMAP
#include "LinkerInternals.h"
#endif
#include <string.h>
#include "ffi.h"
......@@ -1791,6 +1807,20 @@ void flushExec (W_ len, AdjustorExecutable exec_addr)
#endif
}
#if RTS_LINKER_USE_MMAP
AdjustorWritable allocateWrite(W_ bytes) {
return mmapForLinker(bytes, PROT_READ | PROT_WRITE, MAP_ANONYMOUS, -1, 0);
}
void markExec(W_ bytes, AdjustorWritable writ) {
mmapForLinkerMarkExecutable(writ, bytes);
}
void freeWrite(W_ bytes, AdjustorWritable writ) {
munmap(writ, bytes);
}
#endif
#if defined(linux_HOST_OS) || defined(netbsd_HOST_OS)
// On Linux we need to use libffi for allocating executable memory,
......@@ -1820,7 +1850,7 @@ void freeExec (AdjustorExecutable addr)
RELEASE_SM_LOCK
}
#elif (defined(arm_HOST_ARCH) || defined(aarch64_HOST_ARCH)) && (defined(ios_HOST_OS) || defined(darwin_HOST_OS))
#elif defined(darwin_HOST_OS)
static HashTable* allocatedExecs;
......@@ -1828,6 +1858,11 @@ AdjustorWritable allocateExec(W_ bytes, AdjustorExecutable *exec_ret)
{
AdjustorWritable writ;
ffi_closure* cl;
// This check is necessary as we can't use allocateExec for anything *but*
// ffi_closures on ios/darwin on arm. libffi does some heavy lifting to
// get around the X^W restrictions, and we can't just use this codepath
// to allocate generic executable space. For those cases we have to refer
// back to allocateWrite/markExec/freeWrite (see above.)
if (bytes != sizeof(ffi_closure)) {
barf("allocateExec: for ffi_closure only");
}
......
......@@ -2,9 +2,9 @@ module T10279 where
import Language.Haskell.TH
import Language.Haskell.TH.Syntax
-- NB: rts-1.0 is used here because it doesn't change.
-- NB: rts-1.0.1 is used here because it doesn't change.
-- You do need to pick the right version number, otherwise the
-- error message doesn't recognize it as a source package ID,
-- (This is OK, since it will look obviously wrong when they
-- try to find the package in their package database.)
blah = $(conE (Name (mkOccName "Foo") (NameG VarName (mkPkgName "rts-1.0") (mkModName "A"))))
blah = $(conE (Name (mkOccName "Foo") (NameG VarName (mkPkgName "rts-1.0.1") (mkModName "A"))))
T10279.hs:10:9: error:
• Failed to load interface for ‘A’
no unit id matching ‘rts-1.0’ was found
no unit id matching ‘rts-1.0.1’ was found
(This unit ID looks like the source package ID;
the real unit ID is ‘rts’)
• In the expression: rts-1.0:A.Foo
In an equation for ‘blah’: blah = (rts-1.0:A.Foo)
• In the expression: rts-1.0.1:A.Foo
In an equation for ‘blah’: blah = (rts-1.0.1:A.Foo)
......@@ -385,7 +385,7 @@ generate directory distdir config_args
transitiveDepLibNames
| packageKeySupported comp = map fixupRtsLibName transitiveDeps
| otherwise = transitiveDeps
fixupRtsLibName "rts-1.0" = "rts"
fixupRtsLibName x | "rts-" `isPrefixOf` x = "rts"
fixupRtsLibName x = x
transitiveDepNames = map (display . packageName) transitive_dep_ids
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment