diff --git a/compiler/main/Packages.hs b/compiler/main/Packages.hs index f5a8c964b31cccf7952378b4325e862b4c9f10f1..66c46e9d9188b782182b05508448c2ac2d992358 100644 --- a/compiler/main/Packages.hs +++ b/compiler/main/Packages.hs @@ -1862,9 +1862,9 @@ packageHsLibs dflags p = map (mkDynName . addSuffix) (hsLibraries p) -- 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 diff --git a/docs/users_guide/packages.rst b/docs/users_guide/packages.rst index 2d6253bf920e02ef48c8201222d48d8c2f480953..af4d1b293aae5d7ded7e1d4c5320ce57ef1b4b3e 100644 --- a/docs/users_guide/packages.rst +++ b/docs/users_guide/packages.rst @@ -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 diff --git a/hadrian/src/Rules/Rts.hs b/hadrian/src/Rules/Rts.hs index a99d0f40a616ac4d3750f02153e27d64eb471764..4583f06d5169e6d375f18f1ea762cbcdc7d0bfb0 100644 --- a/hadrian/src/Rules/Rts.hs +++ b/hadrian/src/Rules/Rts.hs @@ -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" diff --git a/includes/Rts.h b/includes/Rts.h index 1db3ea0df82e078506e0c2bf97eea30fa11339e0..568a7e610824f9d8976aff75908579b90e5a3970 100644 --- a/includes/Rts.h +++ b/includes/Rts.h @@ -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 diff --git a/includes/rts/storage/GC.h b/includes/rts/storage/GC.h index 889df9a67555d3b58e735cad8303425a3b394e1e..be9c13cdf4edb7acaff3a92c6cea019c701c181a 100644 --- a/includes/rts/storage/GC.h +++ b/includes/rts/storage/GC.h @@ -199,9 +199,15 @@ typedef void* AdjustorExecutable; AdjustorWritable allocateExec(W_ len, AdjustorExecutable *exec_addr); void flushExec(W_ len, AdjustorExecutable exec_addr); -#if defined(ios_HOST_OS) +#if (defined(arm_HOST_ARCH) || defined(aarch64_HOST_ARCH)) && (defined(ios_HOST_OS) || 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: diff --git a/libraries/base/base.cabal b/libraries/base/base.cabal index f5a915d61d168bee7d4bd64bab33b4839d8c0c6d..8884ae3886ba73f0abde22e273f3e5a837305409 100644 --- a/libraries/base/base.cabal +++ b/libraries/base/base.cabal @@ -95,7 +95,7 @@ Library UnliftedFFITypes Unsafe - build-depends: rts == 1.0, ghc-prim >= 0.5.1.0 && < 0.7 + build-depends: rts == 1.0.*, ghc-prim >= 0.5.1.0 && < 0.7 -- sanity-check to ensure exactly one flag is set if !((flag(integer-gmp) && !flag(integer-simple)) || (!flag(integer-gmp) && flag(integer-simple))) diff --git a/libraries/ghci/GHCi/InfoTable.hsc b/libraries/ghci/GHCi/InfoTable.hsc index e48f041b562e8970838e9e92f61df3c311d506d0..bfcb13cf93364d4fcdec7de7f4d07f080c4f9ab9 100644 --- a/libraries/ghci/GHCi/InfoTable.hsc +++ b/libraries/ghci/GHCi/InfoTable.hsc @@ -360,7 +360,11 @@ sizeOfEntryCode -- Note: Must return proper pointer for use in a closure newExecConItbl :: StgInfoTable -> ByteString -> IO (FunPtr ()) newExecConItbl obj con_desc +#if RTS_LINKER_USE_MMAP && MIN_VERSION_rts(1,0,1) + = do +#else = alloca $ \pcode -> do +#endif let lcon_desc = BS.length con_desc + 1{- null terminator -} -- SCARY -- This size represents the number of bytes in an StgConInfoTable. @@ -369,8 +373,13 @@ newExecConItbl 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 wr_ptr ex_ptr cinfo @@ -379,6 +388,9 @@ newExecConItbl 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 #if defined(TABLES_NEXT_TO_CODE) return (castPtrToFunPtr (ex_ptr `plusPtr` conInfoTableSizeB)) #else @@ -391,6 +403,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 62f8ec43a5c2cbd42c1bd5cf1db638ab28b70b73..e64948054997e9bfd60fb7ae7b7af3c97241b9ae 100644 --- a/libraries/ghci/ghci.cabal.in +++ b/libraries/ghci/ghci.cabal.in @@ -71,6 +71,7 @@ library SizedSeq Build-Depends: + rts, array == 0.5.*, base >= 4.8 && < 4.15, binary == 0.8.*, diff --git a/rts/Adjustor.c b/rts/Adjustor.c index d360cfe87b1183dd7f5ff3534f586ede49b1fd2c..7fc931344c95178b6b240d25ead1c8e0d3aa1599 100644 --- a/rts/Adjustor.c +++ b/rts/Adjustor.c @@ -99,7 +99,7 @@ freeHaskellFunctionPtr(void* ptr) { ffi_closure *cl; -#if defined(ios_HOST_OS) +#if defined(ios_HOST_OS) || defined(darwin_HOST_OS) cl = execToWritable(ptr); #else cl = (ffi_closure*)ptr; diff --git a/rts/Linker.c b/rts/Linker.c index c0d28e65814f1d458c2400ca4423b9c9adc94ac7..f0c72c3a2d10a71fde90160dcb4468686f626f51 100644 --- a/rts/Linker.c +++ b/rts/Linker.c @@ -1484,7 +1484,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, diff --git a/rts/LinkerInternals.h b/rts/LinkerInternals.h index b0fab81cb3e0970f6cd93cc779d5b6cf5157c203..1a83771439d763837bbea83828f9c10e0c8a7811 100644 --- a/rts/LinkerInternals.h +++ b/rts/LinkerInternals.h @@ -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> void* mmap_next(void *addr, size_t length, int prot, int flags, int fd, off_t offset); #endif diff --git a/rts/StgCRun.c b/rts/StgCRun.c index 6ce50fcae8fe4bad0934da28b1b9f02bff55d95d..1bb37a7acd556621cc5957c71465e7099e433cd8 100644 --- a/rts/StgCRun.c +++ b/rts/StgCRun.c @@ -899,7 +899,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" @@ -982,7 +982,7 @@ StgRun(StgFunPtr f, StgRegTable *basereg) { "br %1\n\t" ".globl " STG_RETURN "\n\t" -#if !defined(ios_HOST_OS) +#if !defined(ios_HOST_OS) && !defined(darwin_HOST_OS) ".type " STG_RETURN ", %%function\n" #endif STG_RETURN ":\n\t" diff --git a/rts/ghc.mk b/rts/ghc.mk index ada9055ebdfef768db3b0737a3483740decd4b44..a1610fc1f4295cac54a3ba10d5c1a78a8706e43d 100644 --- a/rts/ghc.mk +++ b/rts/ghc.mk @@ -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: diff --git a/rts/package.conf.in b/rts/package.conf.in index 6e1d19d58822471ed303c460e0249d132a689bca..b00d310f0573d478a65fb7546de0365ac70e0a16 100644 --- a/rts/package.conf.in +++ b/rts/package.conf.in @@ -5,7 +5,7 @@ #include "MachDeps.h" name: rts -version: 1.0 +version: 1.0.1 id: rts key: rts license: BSD-3-Clause diff --git a/rts/rts.cabal.in b/rts/rts.cabal.in index 3d4ee0f914dc59ede066e030362b255bb2d33495..276066c6bf9df7ee807abd506d9b8d6adaa3731b 100644 --- a/rts/rts.cabal.in +++ b/rts/rts.cabal.in @@ -1,6 +1,6 @@ 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 diff --git a/rts/sm/Storage.c b/rts/sm/Storage.c index a88073d1f833ad7b2c8a383b2c1ba1d7f20fd42f..9c016b7fbb71a0bdee11a34ef5ed1d77de3408f2 100644 --- a/rts/sm/Storage.c +++ b/rts/sm/Storage.c @@ -30,10 +30,14 @@ #include "GC.h" #include "Evac.h" #include "NonMoving.h" -#if defined(ios_HOST_OS) +#if defined(ios_HOST_OS) || defined(darwin_HOST_OS) #include "Hash.h" #endif +#if RTS_LINKER_USE_MMAP +#include "LinkerInternals.h" +#endif + #include <string.h> #include "ffi.h" @@ -1543,7 +1547,7 @@ StgWord calcTotalCompactW (void) should be modified to use allocateExec instead of VirtualAlloc. ------------------------------------------------------------------------- */ -#if (defined(arm_HOST_ARCH) || defined(aarch64_HOST_ARCH)) && defined(ios_HOST_OS) +#if (defined(arm_HOST_ARCH) || defined(aarch64_HOST_ARCH)) && (defined(ios_HOST_OS) || defined(darwin_HOST_OS)) #include <libkern/OSCacheControl.h> #endif @@ -1574,7 +1578,7 @@ void flushExec (W_ len, AdjustorExecutable exec_addr) /* x86 doesn't need to do anything, so just suppress some warnings. */ (void)len; (void)exec_addr; -#elif (defined(arm_HOST_ARCH) || defined(aarch64_HOST_ARCH)) && defined(ios_HOST_OS) +#elif (defined(arm_HOST_ARCH) || defined(aarch64_HOST_ARCH)) && (defined(ios_HOST_OS) || defined(darwin_HOST_OS)) /* On iOS we need to use the special 'sys_icache_invalidate' call. */ sys_icache_invalidate(exec_addr, len); #elif defined(__clang__) @@ -1628,7 +1632,7 @@ void freeExec (AdjustorExecutable addr) RELEASE_SM_LOCK } -#elif defined(ios_HOST_OS) +#elif defined(darwin_HOST_OS) static HashTable* allocatedExecs; @@ -1636,6 +1640,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"); } @@ -1753,6 +1762,20 @@ void freeExec (void *addr) #endif /* switch(HOST_OS) */ +#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(DEBUG) // handy function for use in gdb, because Bdescr() is inlined. diff --git a/testsuite/tests/th/T10279.hs b/testsuite/tests/th/T10279.hs index fbc2dbbf51eeb4f7694a618b210cf53fc93e98f3..ea0d79de290d28919f0550c2b509f126e6c1b17d 100644 --- a/testsuite/tests/th/T10279.hs +++ b/testsuite/tests/th/T10279.hs @@ -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")))) diff --git a/testsuite/tests/th/T10279.stderr b/testsuite/tests/th/T10279.stderr index 0d23a80877b2a55b0aa309340124fb5361f54f27..7d2224eef133c080dd6360d23269c1eda84ff716 100644 --- a/testsuite/tests/th/T10279.stderr +++ b/testsuite/tests/th/T10279.stderr @@ -1,8 +1,8 @@ T10279.hs:10:10: 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) diff --git a/utils/ghc-cabal/Main.hs b/utils/ghc-cabal/Main.hs index b83ad63aba458a7490b8087876128c82a7dba019..9fe1437ecb8a8419466f5f4aa149f410c3d0cd15 100644 --- a/utils/ghc-cabal/Main.hs +++ b/utils/ghc-cabal/Main.hs @@ -382,7 +382,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