The package rpms/ghc9.2.git has added or updated architecture specific content in its
spec file (ExclusiveArch/ExcludeArch or %ifarch/%ifnarch) in commit(s):
https://src.fedoraproject.org/cgit/rpms/ghc9.2.git/commit/?id=28fa9246a9c....
Change:
+%ifarch armv7hl %{ix86}
Thanks.
Full change:
============
commit 28fa9246a9c556807206cb4a818639a1837f9be9
Author: Jens Petersen <petersen(a)redhat.com>
Date: Tue May 30 10:11:38 2023 +0800
disable haddocks also here
following the main ghc 9.2 package
diff --git a/ghc9.2.spec b/ghc9.2.spec
index a6c49ec..25d7134 100644
--- a/ghc9.2.spec
+++ b/ghc9.2.spec
@@ -35,7 +35,7 @@
%bcond_without ghc_prof
#
https://gitlab.haskell.org/ghc/ghc/-/issues/19754
#
https://github.com/haskell/haddock/issues/1384
-%ifarch armv7hl
+%ifarch armv7hl %{ix86}
%undefine with_haddock
%else
%bcond_without haddock
@@ -289,7 +289,8 @@ Installing this package causes %{name}-*-doc packages corresponding
to
Summary: GHC library documentation indexing
License: BSD-3-Clause
Requires: %{name}-compiler = %{version}-%{release}
-BuildArch: noarch
+# due to disabled haddock archs
+#BuildArch: noarch
%description doc-index
The package enables re-indexing of installed library documention.
@@ -297,7 +298,8 @@ The package enables re-indexing of installed library documention.
%package filesystem
Summary: Shared directories for Haskell documentation
-BuildArch: noarch
+# due to disabled haddock archs
+#BuildArch: noarch
%description filesystem
This package provides some common directories used for
commit 7db25ec0fe67f6a69b8c0fe69cb46282af2bf538
Author: Jens Petersen <petersen(a)redhat.com>
Date: Mon May 29 15:26:04 2023 +0800
update to 9.2.8
diff --git a/.gitignore b/.gitignore
index 8a58621..3ddfb1d 100644
--- a/.gitignore
+++ b/.gitignore
@@ -5,3 +5,4 @@
/ghc-9.2.4-src.tar.lz
/ghc-9.2.5-src.tar.lz
/ghc-9.2.7-src.tar.lz
+/ghc-9.2.8-src.tar.lz
diff --git a/10453.patch b/10453.patch
deleted file mode 100644
index 93585b8..0000000
--- a/10453.patch
+++ /dev/null
@@ -1,2380 +0,0 @@
-From 2271440777681ceb98cc87c43e2798a2b573fa9e Mon Sep 17 00:00:00 2001
-From: Ben Gamari <ben(a)smart-cactus.org>
-Date: Mon, 19 Apr 2021 14:07:21 -0400
-Subject: [PATCH 01/13] rts/m32: Fix bounds check
-
-Previously we would check only that the *start* of the mapping was in
-the bottom 32-bits of address space. However, we need the *entire*
-mapping to be in low memory. Fix this.
-
-Noticed by @Phyx.
-
-(cherry picked from commit 72c1812feecd2aff2a96b629063ba90a2f4cdb7b)
----
- rts/linker/M32Alloc.c | 5 +++--
- 1 file changed, 3 insertions(+), 2 deletions(-)
-
-diff --git a/rts/linker/M32Alloc.c b/rts/linker/M32Alloc.c
-index e7c697bf60b..cd8751b3b04 100644
---- a/rts/linker/M32Alloc.c
-+++ b/rts/linker/M32Alloc.c
-@@ -244,8 +244,9 @@ m32_alloc_page(void)
- * pages.
- */
- const size_t pgsz = getPageSize();
-- uint8_t *chunk = mmapAnonForLinker(pgsz * M32_MAP_PAGES);
-- if (chunk > (uint8_t *) 0xffffffff) {
-+ const size_t map_sz = pgsz * M32_MAP_PAGES;
-+ uint8_t *chunk = mmapAnonForLinker(map_sz);
-+ if (chunk + map_sz > (uint8_t *) 0xffffffff) {
- barf("m32_alloc_page: failed to get allocation in lower 32-bits");
- }
-
---
-GitLab
-
-
-From 12989f386ced001ee3592440402d191e7c9f9fec Mon Sep 17 00:00:00 2001
-From: Ben Gamari <ben(a)well-typed.com>
-Date: Thu, 20 Jan 2022 15:17:10 -0500
-Subject: [PATCH 02/13] rts/m32: Accept any address within 4GB of program text
-
-Previously m32 would assume that the program image was located near the
-start of the address space and therefore assume that it wanted pages
-in the bottom 4GB of address space. Instead we now check whether they
-are within 4GB of whereever the program is loaded.
-
-This is necessary on Windows, which now tends to place the image in high
-memory. The eventual goal is to use m32 to allocate memory for linker
-sections on Windows.
-
-(cherry picked from commit 2e9248b7f7f645851ceb49931d10b9c5e58d2bbb)
----
- rts/Linker.c | 57 +---------------------------------------
- rts/LinkerInternals.h | 60 +++++++++++++++++++++++++++++++++++++++++++
- rts/linker/M32Alloc.c | 27 +++++++++++--------
- 3 files changed, 78 insertions(+), 66 deletions(-)
-
-diff --git a/rts/Linker.c b/rts/Linker.c
-index 3bbe4b8340a..51d87d05bc3 100644
---- a/rts/Linker.c
-+++ b/rts/Linker.c
-@@ -198,62 +198,7 @@ Mutex linker_mutex;
- /* Generic wrapper function to try and Resolve and RunInit oc files */
- int ocTryLoad( ObjectCode* oc );
-
--/* Link objects into the lower 2Gb on x86_64 and AArch64. GHC assumes the
-- * small memory model on this architecture (see gcc docs,
-- * -mcmodel=small).
-- *
-- * MAP_32BIT not available on OpenBSD/amd64
-- */
--#if defined(MAP_32BIT) && (defined(x86_64_HOST_ARCH) ||
(defined(aarch64_TARGET_ARCH) || defined(aarch64_HOST_ARCH)))
--#define MAP_LOW_MEM
--#define TRY_MAP_32BIT MAP_32BIT
--#else
--#define TRY_MAP_32BIT 0
--#endif
--
--#if defined(aarch64_HOST_ARCH)
--// On AArch64 MAP_32BIT is not available but we are still bound by the small
--// memory model. Consequently we still try using the MAP_LOW_MEM allocation
--// strategy.
--#define MAP_LOW_MEM
--#endif
--
--/*
-- * Note [MAP_LOW_MEM]
-- * ~~~~~~~~~~~~~~~~~~
-- * Due to the small memory model (see above), on x86_64 and AArch64 we have to
-- * map all our non-PIC object files into the low 2Gb of the address space (why
-- * 2Gb and not 4Gb? Because all addresses must be reachable using a 32-bit
-- * signed PC-relative offset). On x86_64 Linux we can do this using the
-- * MAP_32BIT flag to mmap(), however on other OSs (e.g. *BSD, see #2063, and
-- * also on Linux inside Xen, see #2512), we can't do this. So on these
-- * systems, we have to pick a base address in the low 2Gb of the address space
-- * and try to allocate memory from there.
-- *
-- * The same holds for aarch64, where the default, even with PIC, model
-- * is 4GB. The linker is free to emit AARCH64_ADR_PREL_PG_HI21
-- * relocations.
-- *
-- * We pick a default address based on the OS, but also make this
-- * configurable via an RTS flag (+RTS -xm)
-- */
--
--#if (defined(aarch64_TARGET_ARCH) || defined(aarch64_HOST_ARCH))
--// Try to use stg_upd_frame_info as the base. We need to be within +-4GB of that
--// address, otherwise we violate the aarch64 memory model. Any object we load
--// can potentially reference any of the ones we bake into the binary (and list)
--// in RtsSymbols. Thus we'll need to be within +-4GB of those,
--// stg_upd_frame_info is a good candidate as it's referenced often.
--#define MMAP_32BIT_BASE_DEFAULT (void*)&stg_upd_frame_info;
--#elif defined(MAP_32BIT) || DEFAULT_LINKER_ALWAYS_PIC
--// Try to use MAP_32BIT
--#define MMAP_32BIT_BASE_DEFAULT 0
--#else
--// A guess: 1Gb.
--#define MMAP_32BIT_BASE_DEFAULT 0x40000000
--#endif
--
--static void *mmap_32bit_base = (void *)MMAP_32BIT_BASE_DEFAULT;
-+static void *mmap_32bit_base = LINKER_LOAD_BASE;
-
- static void ghciRemoveSymbolTable(StrHashTable *table, const SymbolName* key,
- ObjectCode *owner)
-diff --git a/rts/LinkerInternals.h b/rts/LinkerInternals.h
-index 7058ad355b6..c4681e364bd 100644
---- a/rts/LinkerInternals.h
-+++ b/rts/LinkerInternals.h
-@@ -433,6 +433,66 @@ resolveSymbolAddr (pathchar* buffer, int size,
- #define USE_CONTIGUOUS_MMAP 0
- #endif
-
-+/* Link objects into the lower 2Gb on x86_64 and AArch64. GHC assumes the
-+ * small memory model on this architecture (see gcc docs,
-+ * -mcmodel=small).
-+ *
-+ * MAP_32BIT not available on OpenBSD/amd64
-+ */
-+#if defined(MAP_32BIT) && (defined(x86_64_HOST_ARCH) ||
(defined(aarch64_TARGET_ARCH) || defined(aarch64_HOST_ARCH)))
-+#define MAP_LOW_MEM
-+#define TRY_MAP_32BIT MAP_32BIT
-+#else
-+#define TRY_MAP_32BIT 0
-+#endif
-+
-+#if defined(aarch64_HOST_ARCH)
-+// On AArch64 MAP_32BIT is not available but we are still bound by the small
-+// memory model. Consequently we still try using the MAP_LOW_MEM allocation
-+// strategy.
-+#define MAP_LOW_MEM
-+#endif
-+
-+/*
-+ * Note [MAP_LOW_MEM]
-+ * ~~~~~~~~~~~~~~~~~~
-+ * Due to the small memory model (see above), on x86_64 and AArch64 we have to
-+ * map all our non-PIC object files into the low 2Gb of the address space (why
-+ * 2Gb and not 4Gb? Because all addresses must be reachable using a 32-bit
-+ * signed PC-relative offset). On x86_64 Linux we can do this using the
-+ * MAP_32BIT flag to mmap(), however on other OSs (e.g. *BSD, see #2063, and
-+ * also on Linux inside Xen, see #2512), we can't do this. So on these
-+ * systems, we have to pick a base address in the low 2Gb of the address space
-+ * and try to allocate memory from there.
-+ *
-+ * The same holds for aarch64, where the default, even with PIC, model
-+ * is 4GB. The linker is free to emit AARCH64_ADR_PREL_PG_HI21
-+ * relocations.
-+ *
-+ * We pick a default address based on the OS, but also make this
-+ * configurable via an RTS flag (+RTS -xm)
-+ */
-+
-+#if defined(aarch64_TARGET_ARCH) || defined(aarch64_HOST_ARCH)
-+// Try to use stg_upd_frame_info as the base. We need to be within +-4GB of that
-+// address, otherwise we violate the aarch64 memory model. Any object we load
-+// can potentially reference any of the ones we bake into the binary (and list)
-+// in RtsSymbols. Thus we'll need to be within +-4GB of those,
-+// stg_upd_frame_info is a good candidate as it's referenced often.
-+#define LINKER_LOAD_BASE ((void *) &stg_upd_frame_info)
-+#elif defined(x86_64_HOST_ARCH) && defined(mingw32_HOST_OS)
-+// On Windows (which now uses high-entropy ASLR by default) we need to ensure
-+// that we map code near the executable image. We use stg_upd_frame_info as a
-+// proxy for the image location.
-+#define LINKER_LOAD_BASE ((void *) &stg_upd_frame_info)
-+#elif defined(MAP_32BIT) || DEFAULT_LINKER_ALWAYS_PIC
-+// Try to use MAP_32BIT
-+#define LINKER_LOAD_BASE ((void *) 0x0)
-+#else
-+// A guess: 1 GB.
-+#define LINKER_LOAD_BASE ((void *) 0x40000000)
-+#endif
-+
- HsInt isAlreadyLoaded( pathchar *path );
- OStatus getObjectLoadStatus_ (pathchar *path);
- HsInt loadOc( ObjectCode* oc );
-diff --git a/rts/linker/M32Alloc.c b/rts/linker/M32Alloc.c
-index cd8751b3b04..6945f50a71b 100644
---- a/rts/linker/M32Alloc.c
-+++ b/rts/linker/M32Alloc.c
-@@ -149,6 +149,14 @@ The allocator is *not* thread-safe.
- /* Upper bound on the number of pages to keep in the free page pool */
- #define M32_MAX_FREE_PAGE_POOL_SIZE 64
-
-+/* A utility to verify that a given address is "acceptable" for use by m32.
*/
-+static bool
-+is_okay_address(void *p) {
-+ int8_t *here = LINKER_LOAD_BASE;
-+ ssize_t displacement = (int8_t *) p - here;
-+ return (displacement > -0x7fffffff) && (displacement < 0x7fffffff);
-+}
-+
- /**
- * Page header
- *
-@@ -161,8 +169,7 @@ struct m32_page_t {
- // unprotected_list or protected_list are linked together with this field.
- struct {
- uint32_t size;
-- uint32_t next; // this is a m32_page_t*, truncated to 32-bits. This is safe
-- // as we are only allocating in the bottom 32-bits
-+ struct m32_page_t *next;
- } filled_page;
-
- // Pages in the small-allocation nursery encode their current allocation
-@@ -179,10 +186,10 @@ struct m32_page_t {
- static void
- m32_filled_page_set_next(struct m32_page_t *page, struct m32_page_t *next)
- {
-- if (next > (struct m32_page_t *) 0xffffffff) {
-- barf("m32_filled_page_set_next: Page not in lower 32-bits");
-+ if (! is_okay_address(next)) {
-+ barf("m32_filled_page_set_next: Page not within 4GB of program text");
- }
-- page->filled_page.next = (uint32_t) (uintptr_t) next;
-+ page->filled_page.next = next;
- }
-
- static struct m32_page_t *
-@@ -246,8 +253,8 @@ m32_alloc_page(void)
- const size_t pgsz = getPageSize();
- const size_t map_sz = pgsz * M32_MAP_PAGES;
- uint8_t *chunk = mmapAnonForLinker(map_sz);
-- if (chunk + map_sz > (uint8_t *) 0xffffffff) {
-- barf("m32_alloc_page: failed to get allocation in lower 32-bits");
-+ if (! is_okay_address(chunk + map_sz)) {
-+ barf("m32_alloc_page: failed to allocate pages within 4GB of program text
(got %p)", chunk);
- }
-
- #define GET_PAGE(i) ((struct m32_page_t *) (chunk + (i) * pgsz))
-@@ -393,9 +400,9 @@ m32_alloc(struct m32_allocator_t *alloc, size_t size, size_t
alignment)
- if (page == NULL) {
- sysErrorBelch("m32_alloc: Failed to map pages for %zd bytes",
size);
- return NULL;
-- } else if (page > (struct m32_page_t *) 0xffffffff) {
-- debugBelch("m32_alloc: warning: Allocation of %zd bytes resulted in pages
above 4GB (%p)",
-- size, page);
-+ } else if (! is_okay_address(page)) {
-+ barf("m32_alloc: warning: Allocation of %zd bytes resulted in pages above
4GB (%p)",
-+ size, page);
- }
- page->filled_page.size = alsize + size;
- m32_allocator_push_filled_list(&alloc->unprotected_list, (struct m32_page_t
*) page);
---
-GitLab
-
-
-From b15da5a9bcf837d53f46c8b3daea55e55b8e7f34 Mon Sep 17 00:00:00 2001
-From: GHC GitLab CI <ghc-ci(a)gitlab-haskell.org>
-Date: Fri, 28 Jan 2022 22:33:52 -0500
-Subject: [PATCH 03/13] rts: Generalize mmapForLinkerMarkExecutable
-
-Renamed to mprotectForLinker and allowed setting of arbitrary protection
-modes.
-
-(cherry picked from commit 86589b893c092ae900723e76848525f20f6cafbf)
----
- rts/ExecPage.c | 2 +-
- rts/Linker.c | 56 ++++++++++++++++++++++++++++++++-------
- rts/LinkerInternals.h | 10 ++++++-
- rts/linker/Elf.c | 2 +-
- rts/linker/M32Alloc.c | 2 +-
- rts/linker/MachO.c | 4 +--
- rts/linker/SymbolExtras.c | 2 +-
- 7 files changed, 61 insertions(+), 17 deletions(-)
-
-diff --git a/rts/ExecPage.c b/rts/ExecPage.c
-index 6f5b6e281ab..24d4d65bad4 100644
---- a/rts/ExecPage.c
-+++ b/rts/ExecPage.c
-@@ -15,7 +15,7 @@ ExecPage *allocateExecPage() {
- }
-
- void freezeExecPage(ExecPage *page) {
-- mmapForLinkerMarkExecutable(page, getPageSize());
-+ mprotectForLinker(page, getPageSize(), MEM_READ_EXECUTE);
- flushExec(getPageSize(), page);
- }
-
-diff --git a/rts/Linker.c b/rts/Linker.c
-index 51d87d05bc3..225457f24a9 100644
---- a/rts/Linker.c
-+++ b/rts/Linker.c
-@@ -1048,6 +1048,17 @@ resolveSymbolAddr (pathchar* buffer, int size,
- #endif /* OBJFORMAT_PEi386 */
- }
-
-+static const char *memoryAccessDescription(MemoryAccess mode)
-+{
-+ switch (mode) {
-+ case MEM_NO_ACCESS: return "no-access";
-+ case MEM_READ_ONLY: return "read-only";
-+ case MEM_READ_WRITE: return "read-write";
-+ case MEM_READ_EXECUTE: return "read-execute";
-+ default: barf("invalid MemoryAccess");
-+ }
-+}
-+
- #if defined(mingw32_HOST_OS)
-
- //
-@@ -1068,16 +1079,29 @@ munmapForLinker (void *addr, size_t bytes, const char *caller)
- }
- }
-
-+/**
-+ * Change the allowed access modes of a region of memory previously allocated
-+ * with mmapAnonForLinker.
-+ */
- void
--mmapForLinkerMarkExecutable(void *start, size_t len)
-+mprotectForLinker(void *start, size_t len, MemoryAccess mode)
- {
- DWORD old;
- if (len == 0) {
- return;
- }
-- if (VirtualProtect(start, len, PAGE_EXECUTE_READ, &old) == 0) {
-- sysErrorBelch("mmapForLinkerMarkExecutable: failed to protect %zd bytes at
%p",
-- len, start);
-+ DWORD prot;
-+ switch (mode) {
-+ case MEM_NO_ACCESS: prot = PAGE_NOACCESS; break;
-+ case MEM_READ_ONLY: prot = PAGE_READONLY; break;
-+ case MEM_READ_WRITE: prot = PAGE_READWRITE; break;
-+ case MEM_READ_EXECUTE: prot = PAGE_EXECUTE_READ; break;
-+ default: barf("invalid MemoryAccess");
-+ }
-+
-+ if (VirtualProtect(start, len, prot, &old) == 0) {
-+ sysErrorBelch("mprotectForLinker: failed to protect %zd bytes at %p as
%s",
-+ len, start, memoryAccessDescription(mode));
- ASSERT(false);
- }
- }
-@@ -1229,7 +1253,7 @@ void munmapForLinker (void *addr, size_t bytes, const char
*caller)
- *
- * Consequently mmapForLinker now maps its memory with PROT_READ|PROT_WRITE.
- * After the linker has finished filling/relocating the mapping it must then
-- * call mmapForLinkerMarkExecutable on the sections of the mapping which
-+ * call mprotectForLinker on the sections of the mapping which
- * contain executable code.
- *
- * Note that the m32 allocator handles protection of its allocations. For this
-@@ -1245,16 +1269,28 @@ void munmapForLinker (void *addr, size_t bytes, const char
*caller)
- * Mark an portion of a mapping previously reserved by mmapForLinker
- * as executable (but not writable).
- */
--void mmapForLinkerMarkExecutable(void *start, size_t len)
-+void mprotectForLinker(void *start, size_t len, MemoryAccess mode)
- {
- if (len == 0) {
- return;
- }
- IF_DEBUG(linker,
-- debugBelch("mmapForLinkerMarkExecutable: protecting %" FMT_Word
-- " bytes starting at %p\n", (W_)len, start));
-- if (mprotect(start, len, PROT_READ|PROT_EXEC) == -1) {
-- barf("mmapForLinkerMarkExecutable: mprotect: %s\n", strerror(errno));
-+ debugBelch("mprotectForLinker: protecting %" FMT_Word
-+ " bytes starting at %p as %s\n",
-+ (W_)len, start, memoryAccessDescription(mode)));
-+
-+ int prot;
-+ switch (mode) {
-+ case MEM_NO_ACCESS: prot = 0; break;
-+ case MEM_READ_ONLY: prot = PROT_READ; break;
-+ case MEM_READ_WRITE: prot = PROT_READ | PROT_WRITE; break;
-+ case MEM_READ_EXECUTE: prot = PROT_READ | PROT_EXEC; break;
-+ default: barf("invalid MemoryAccess");
-+ }
-+
-+ if (mprotect(start, len, prot) == -1) {
-+ sysErrorBelch("mprotectForLinker: failed to protect %zd bytes at %p as
%s",
-+ len, start, memoryAccessDescription(mode));
- }
- }
- #endif
-diff --git a/rts/LinkerInternals.h b/rts/LinkerInternals.h
-index c4681e364bd..3e6b3df9dab 100644
---- a/rts/LinkerInternals.h
-+++ b/rts/LinkerInternals.h
-@@ -374,9 +374,17 @@ void exitLinker( void );
- void freeObjectCode (ObjectCode *oc);
- SymbolAddr* loadSymbol(SymbolName *lbl, RtsSymbolInfo *pinfo);
-
-+/** Access modes for mprotectForLinker */
-+typedef enum {
-+ MEM_NO_ACCESS,
-+ MEM_READ_ONLY,
-+ MEM_READ_WRITE,
-+ MEM_READ_EXECUTE,
-+} MemoryAccess;
-+
- void *mmapAnonForLinker (size_t bytes);
- void *mmapForLinker (size_t bytes, uint32_t prot, uint32_t flags, int fd, int offset);
--void mmapForLinkerMarkExecutable (void *start, size_t len);
-+void mprotectForLinker(void *start, size_t len, MemoryAccess mode);
- void munmapForLinker (void *addr, size_t bytes, const char *caller);
-
- void addProddableBlock ( ObjectCode* oc, void* start, int size );
-diff --git a/rts/linker/Elf.c b/rts/linker/Elf.c
-index f6a1754257a..980d4b80f05 100644
---- a/rts/linker/Elf.c
-+++ b/rts/linker/Elf.c
-@@ -1877,7 +1877,7 @@ ocMprotect_Elf( ObjectCode *oc )
- if (section->alloc != SECTION_M32) {
- // N.B. m32 handles protection of its allocations during
- // flushing.
-- mmapForLinkerMarkExecutable(section->mapped_start,
section->mapped_size);
-+ mprotectForLinker(section->mapped_start, section->mapped_size,
MEM_READ_EXECUTE);
- }
- break;
- default:
-diff --git a/rts/linker/M32Alloc.c b/rts/linker/M32Alloc.c
-index 6945f50a71b..a40cc701c06 100644
---- a/rts/linker/M32Alloc.c
-+++ b/rts/linker/M32Alloc.c
-@@ -366,7 +366,7 @@ m32_allocator_flush(m32_allocator *alloc) {
- while (page != NULL) {
- struct m32_page_t *next = m32_filled_page_get_next(page);
- m32_allocator_push_filled_list(&alloc->protected_list, page);
-- mmapForLinkerMarkExecutable(page, page->filled_page.size);
-+ mprotectForLinker(page, page->filled_page.size, MEM_READ_EXECUTE);
- page = next;
- }
- alloc->unprotected_list = NULL;
-diff --git a/rts/linker/MachO.c b/rts/linker/MachO.c
-index 1a18ee6a740..d037c82f458 100644
---- a/rts/linker/MachO.c
-+++ b/rts/linker/MachO.c
-@@ -1428,7 +1428,7 @@ ocMprotect_MachO( ObjectCode *oc )
- if(segment->size == 0) continue;
-
- if(segment->prot == SEGMENT_PROT_RX) {
-- mmapForLinkerMarkExecutable(segment->start, segment->size);
-+ mprotectForLinker(segment->start, segment->size, MEM_READ_EXECUTE);
- }
- }
-
-@@ -1443,7 +1443,7 @@ ocMprotect_MachO( ObjectCode *oc )
- if(section->alloc == SECTION_M32) continue;
- switch (section->kind) {
- case SECTIONKIND_CODE_OR_RODATA: {
-- mmapForLinkerMarkExecutable(section->mapped_start,
section->mapped_size);
-+ mprotectForLinker(section->mapped_start, section->mapped_size,
MEM_READ_EXECUTE);
- break;
- }
- default:
-diff --git a/rts/linker/SymbolExtras.c b/rts/linker/SymbolExtras.c
-index ddb58e4a4e8..5c04e9b3a87 100644
---- a/rts/linker/SymbolExtras.c
-+++ b/rts/linker/SymbolExtras.c
-@@ -142,7 +142,7 @@ void ocProtectExtras(ObjectCode* oc)
- * non-executable.
- */
- } else if (USE_CONTIGUOUS_MMAP || RtsFlags.MiscFlags.linkerAlwaysPic) {
-- mmapForLinkerMarkExecutable(oc->symbol_extras, sizeof(SymbolExtra) *
oc->n_symbol_extras);
-+ mprotectForLinker(oc->symbol_extras, sizeof(SymbolExtra) *
oc->n_symbol_extras, MEM_READ_EXECUTE);
- } else {
- /*
- * The symbol extras were allocated via m32. They will be protected when
---
-GitLab
-
-
-From aa3e68222dda906d3332e79cab74144b48241e20 Mon Sep 17 00:00:00 2001
-From: GHC GitLab CI <ghc-ci(a)gitlab-haskell.org>
-Date: Fri, 28 Jan 2022 21:02:23 -0500
-Subject: [PATCH 04/13] rts/m32: Add consistency-checking infrastructure
-
-This adds logic, enabled in the `-debug` RTS for checking the internal
-consistency of the m32 allocator. This area has always made me a bit
-nervous so this should help me sleep better at night in exchange for
-very little overhead.
-
-(cherry picked from commit 88ef270aa0cecf2463396f93a273656de9df9433)
----
- rts/linker/M32Alloc.c | 107 +++++++++++++++++++++++++++++++++++++-----
- 1 file changed, 96 insertions(+), 11 deletions(-)
-
-diff --git a/rts/linker/M32Alloc.c b/rts/linker/M32Alloc.c
-index a40cc701c06..7fcf2fc0e02 100644
---- a/rts/linker/M32Alloc.c
-+++ b/rts/linker/M32Alloc.c
-@@ -135,6 +135,11 @@ The allocator is *not* thread-safe.
-
- */
-
-+// Enable internal consistency checking
-+#if defined(DEBUG)
-+#define M32_DEBUG
-+#endif
-+
- #define ROUND_UP(x,size) ((x + size - 1) & ~(size - 1))
- #define ROUND_DOWN(x,size) (x & ~(size - 1))
-
-@@ -157,6 +162,12 @@ is_okay_address(void *p) {
- return (displacement > -0x7fffffff) && (displacement < 0x7fffffff);
- }
-
-+enum m32_page_type {
-+ FREE_PAGE, // a page in the free page pool
-+ NURSERY_PAGE, // a nursery page
-+ FILLED_PAGE, // a page on the filled list
-+};
-+
- /**
- * Page header
- *
-@@ -181,13 +192,55 @@ struct m32_page_t {
- struct m32_page_t *next;
- } free_page;
- };
-+#if defined(M32_DEBUG)
-+ enum m32_page_type type;
-+#endif
-+ uint8_t contents[];
- };
-
-+/* Consistency-checking infrastructure */
-+#if defined(M32_DEBUG)
-+static void ASSERT_PAGE_ALIGNED(void *page) {
-+ const size_t pgsz = getPageSize();
-+ if ((((uintptr_t) page) & (pgsz-1)) != 0) {
-+ barf("m32: invalid page alignment");
-+ }
-+}
-+static void ASSERT_VALID_PAGE(struct m32_page_t *page) {
-+ ASSERT_PAGE_ALIGNED(page);
-+ switch (page->type) {
-+ case FREE_PAGE:
-+ case NURSERY_PAGE:
-+ case FILLED_PAGE:
-+ break;
-+ default:
-+ barf("m32: invalid page state\n");
-+ }
-+}
-+static void ASSERT_PAGE_TYPE(struct m32_page_t *page, enum m32_page_type ty) {
-+ if (page->type != ty) { barf("m32: unexpected page type"); }
-+}
-+static void ASSERT_PAGE_NOT_FREE(struct m32_page_t *page) {
-+ if (page->type == FREE_PAGE) { barf("m32: unexpected free page"); }
-+}
-+static void SET_PAGE_TYPE(struct m32_page_t *page, enum m32_page_type ty) {
-+ page->type = ty;
-+}
-+#else
-+#define ASSERT_PAGE_ALIGNED(page)
-+#define ASSERT_VALID_PAGE(page)
-+#define ASSERT_PAGE_NOT_FREE(page)
-+#define ASSERT_PAGE_TYPE(page, ty)
-+#define SET_PAGE_TYPE(page, ty)
-+#endif
-+
-+/* Accessors */
- static void
- m32_filled_page_set_next(struct m32_page_t *page, struct m32_page_t *next)
- {
-- if (! is_okay_address(next)) {
-- barf("m32_filled_page_set_next: Page not within 4GB of program text");
-+ ASSERT_PAGE_TYPE(page, FILLED_PAGE);
-+ if (next != NULL && ! is_okay_address(next)) {
-+ barf("m32_filled_page_set_next: Page %p not within 4GB of program text",
next);
- }
- page->filled_page.next = next;
- }
-@@ -195,7 +248,8 @@ m32_filled_page_set_next(struct m32_page_t *page, struct m32_page_t
*next)
- static struct m32_page_t *
- m32_filled_page_get_next(struct m32_page_t *page)
- {
-- return (struct m32_page_t *) (uintptr_t) page->filled_page.next;
-+ ASSERT_PAGE_TYPE(page, FILLED_PAGE);
-+ return (struct m32_page_t *) (uintptr_t) page->filled_page.next;
- }
-
- /**
-@@ -220,21 +274,42 @@ struct m32_allocator_t {
- * We keep a small pool of free pages around to avoid fragmentation.
- */
- struct m32_page_t *m32_free_page_pool = NULL;
-+/** Number of pages in free page pool */
- unsigned int m32_free_page_pool_size = 0;
--// TODO
-
- /**
-- * Free a page or, if possible, place it in the free page pool.
-+ * Free a filled page or, if possible, place it in the free page pool.
- */
- static void
- m32_release_page(struct m32_page_t *page)
- {
-- if (m32_free_page_pool_size < M32_MAX_FREE_PAGE_POOL_SIZE) {
-- page->free_page.next = m32_free_page_pool;
-- m32_free_page_pool = page;
-- m32_free_page_pool_size ++;
-- } else {
-- munmapForLinker((void *) page, getPageSize(), "m32_release_page");
-+ // Some sanity-checking
-+ ASSERT_VALID_PAGE(page);
-+ ASSERT_PAGE_NOT_FREE(page);
-+
-+ const size_t pgsz = getPageSize();
-+ ssize_t sz = page->filled_page.size;
-+ IF_DEBUG(sanity, memset(page, 0xaa, sz));
-+
-+ // Break the page, which may be a large multi-page allocation, into
-+ // individual pages for the page pool
-+ while (sz > 0) {
-+ if (m32_free_page_pool_size < M32_MAX_FREE_PAGE_POOL_SIZE) {
-+ mprotectForLinker(page, pgsz, MEM_READ_WRITE);
-+ SET_PAGE_TYPE(page, FREE_PAGE);
-+ page->free_page.next = m32_free_page_pool;
-+ m32_free_page_pool = page;
-+ m32_free_page_pool_size ++;
-+ } else {
-+ break;
-+ }
-+ page = (struct m32_page_t *) ((uint8_t *) page + pgsz);
-+ sz -= pgsz;
-+ }
-+
-+ // The free page pool is full, release the rest back to the system
-+ if (sz > 0) {
-+ munmapForLinker((void *) page, ROUND_UP(sz, pgsz), "m32_release_page");
- }
- }
-
-@@ -256,10 +331,12 @@ m32_alloc_page(void)
- if (! is_okay_address(chunk + map_sz)) {
- barf("m32_alloc_page: failed to allocate pages within 4GB of program text
(got %p)", chunk);
- }
-+ IF_DEBUG(sanity, memset(chunk, 0xaa, map_sz));
-
- #define GET_PAGE(i) ((struct m32_page_t *) (chunk + (i) * pgsz))
- for (int i=0; i < M32_MAP_PAGES; i++) {
- struct m32_page_t *page = GET_PAGE(i);
-+ SET_PAGE_TYPE(page, FREE_PAGE);
- page->free_page.next = GET_PAGE(i+1);
- }
-
-@@ -272,6 +349,7 @@ m32_alloc_page(void)
- struct m32_page_t *page = m32_free_page_pool;
- m32_free_page_pool = page->free_page.next;
- m32_free_page_pool_size --;
-+ ASSERT_PAGE_TYPE(page, FREE_PAGE);
- return page;
- }
-
-@@ -297,6 +375,7 @@ static void
- m32_allocator_unmap_list(struct m32_page_t *head)
- {
- while (head != NULL) {
-+ ASSERT_VALID_PAGE(head);
- struct m32_page_t *next = m32_filled_page_get_next(head);
- munmapForLinker((void *) head, head->filled_page.size,
"m32_allocator_unmap_list");
- head = next;
-@@ -355,6 +434,7 @@ m32_allocator_flush(m32_allocator *alloc) {
- m32_release_page(alloc->pages[i]);
- } else {
- // the page contains data, move it to the unprotected list
-+ SET_PAGE_TYPE(alloc->pages[i], FILLED_PAGE);
- m32_allocator_push_filled_list(&alloc->unprotected_list,
alloc->pages[i]);
- }
- alloc->pages[i] = NULL;
-@@ -364,6 +444,7 @@ m32_allocator_flush(m32_allocator *alloc) {
- if (alloc->executable) {
- struct m32_page_t *page = alloc->unprotected_list;
- while (page != NULL) {
-+ ASSERT_PAGE_TYPE(page, FILLED_PAGE);
- struct m32_page_t *next = m32_filled_page_get_next(page);
- m32_allocator_push_filled_list(&alloc->protected_list, page);
- mprotectForLinker(page, page->filled_page.size, MEM_READ_EXECUTE);
-@@ -404,6 +485,7 @@ m32_alloc(struct m32_allocator_t *alloc, size_t size, size_t
alignment)
- barf("m32_alloc: warning: Allocation of %zd bytes resulted in pages above
4GB (%p)",
- size, page);
- }
-+ SET_PAGE_TYPE(page, FILLED_PAGE);
- page->filled_page.size = alsize + size;
- m32_allocator_push_filled_list(&alloc->unprotected_list, (struct m32_page_t
*) page);
- return (char*) page + alsize;
-@@ -422,6 +504,8 @@ m32_alloc(struct m32_allocator_t *alloc, size_t size, size_t
alignment)
- }
-
- // page can contain the buffer?
-+ ASSERT_VALID_PAGE(alloc->pages[i]);
-+ ASSERT_PAGE_TYPE(alloc->pages[i], NURSERY_PAGE);
- size_t alsize = ROUND_UP(alloc->pages[i]->current_size, alignment);
- if (size <= pgsz - alsize) {
- void * addr = (char*)alloc->pages[i] + alsize;
-@@ -449,6 +533,7 @@ m32_alloc(struct m32_allocator_t *alloc, size_t size, size_t
alignment)
- if (page == NULL) {
- return NULL;
- }
-+ SET_PAGE_TYPE(page, NURSERY_PAGE);
- alloc->pages[empty] = page;
- // Add header size and padding
- alloc->pages[empty]->current_size =
---
-GitLab
-
-
-From 4671c81888a8a3bd09140094cffa98ca8d83a3d7 Mon Sep 17 00:00:00 2001
-From: Ben Gamari <ben(a)smart-cactus.org>
-Date: Sat, 29 Jan 2022 10:41:18 -0500
-Subject: [PATCH 05/13] rts/m32: Free large objects back to the free page pool
-
-Not entirely convinced that this is worth doing.
-
-(cherry picked from commit 2d6f0b17e3ce9326abd43e187910db0a5e519efa)
----
- rts/linker/M32Alloc.c | 5 ++---
- 1 file changed, 2 insertions(+), 3 deletions(-)
-
-diff --git a/rts/linker/M32Alloc.c b/rts/linker/M32Alloc.c
-index 7fcf2fc0e02..6f1f8492d71 100644
---- a/rts/linker/M32Alloc.c
-+++ b/rts/linker/M32Alloc.c
-@@ -377,7 +377,7 @@ m32_allocator_unmap_list(struct m32_page_t *head)
- while (head != NULL) {
- ASSERT_VALID_PAGE(head);
- struct m32_page_t *next = m32_filled_page_get_next(head);
-- munmapForLinker((void *) head, head->filled_page.size,
"m32_allocator_unmap_list");
-+ m32_release_page(head);
- head = next;
- }
- }
-@@ -392,10 +392,9 @@ void m32_allocator_free(m32_allocator *alloc)
- m32_allocator_unmap_list(alloc->protected_list);
-
- /* free partially-filled pages */
-- const size_t pgsz = getPageSize();
- for (int i=0; i < M32_MAX_PAGES; i++) {
- if (alloc->pages[i]) {
-- munmapForLinker(alloc->pages[i], pgsz, "m32_allocator_free");
-+ m32_release_page(alloc->pages[i]);
- }
- }
-
---
-GitLab
-
-
-From 13e7ebd81fa8144a756e327e24612e2e6a4cd074 Mon Sep 17 00:00:00 2001
-From: GHC GitLab CI <ghc-ci(a)gitlab-haskell.org>
-Date: Fri, 28 Jan 2022 21:05:53 -0500
-Subject: [PATCH 06/13] rts/m32: Increase size of free page pool to 256 pages
-
-(cherry picked from commit e96f50beec172f5ff95769842cb9be724363311c)
----
- rts/linker/M32Alloc.c | 2 +-
- 1 file changed, 1 insertion(+), 1 deletion(-)
-
-diff --git a/rts/linker/M32Alloc.c b/rts/linker/M32Alloc.c
-index 6f1f8492d71..46bf72f52ed 100644
---- a/rts/linker/M32Alloc.c
-+++ b/rts/linker/M32Alloc.c
-@@ -152,7 +152,7 @@ The allocator is *not* thread-safe.
- /* How many pages should we map at once when re-filling the free page pool? */
- #define M32_MAP_PAGES 32
- /* Upper bound on the number of pages to keep in the free page pool */
--#define M32_MAX_FREE_PAGE_POOL_SIZE 64
-+#define M32_MAX_FREE_PAGE_POOL_SIZE 256
-
- /* A utility to verify that a given address is "acceptable" for use by m32.
*/
- static bool
---
-GitLab
-
-
-From 5c31cd4ce13a980320fc44fd62c6984c7ed84ed2 Mon Sep 17 00:00:00 2001
-From: Ben Gamari <ben(a)smart-cactus.org>
-Date: Thu, 3 Feb 2022 10:06:35 -0500
-Subject: [PATCH 07/13] rts: Dump memory map on memory mapping failures
-
-Fixes #20992.
-
-(cherry picked from commit fc083b480adedf26d47f880402f111680ec34183)
----
- rts/Linker.c | 3 +
- rts/MemoryMap.c | 138 ++++++++++++++++++++++++++++++++++++++++++
- rts/MemoryMap.h | 13 ++++
- rts/linker/M32Alloc.c | 3 +
- rts/rts.cabal.in | 1 +
- 5 files changed, 158 insertions(+)
- create mode 100644 rts/MemoryMap.c
- create mode 100644 rts/MemoryMap.h
-
-diff --git a/rts/Linker.c b/rts/Linker.c
-index 225457f24a9..4a59f187f24 100644
---- a/rts/Linker.c
-+++ b/rts/Linker.c
-@@ -33,6 +33,7 @@
- #include "linker/SymbolExtras.h"
- #include "PathUtils.h"
- #include "CheckUnload.h" // createOCSectionIndices
-+#include "MemoryMap.h"
-
- #if !defined(mingw32_HOST_OS)
- #include "posix/Signals.h"
-@@ -1146,6 +1147,7 @@ mmap_again:
- MAP_PRIVATE|tryMap32Bit|fixed|flags, fd, offset);
-
- if (result == MAP_FAILED) {
-+ reportMemoryMap();
- sysErrorBelch("mmap %" FMT_Word " bytes at
%p",(W_)size,map_addr);
- errorBelch("Try specifying an address with +RTS -xm<addr>
-RTS");
- return NULL;
-@@ -1168,6 +1170,7 @@ mmap_again:
- fixed = MAP_FIXED;
- goto mmap_again;
- #else
-+ reportMemoryMap();
- errorBelch("mmapForLinker: failed to mmap() memory below 2Gb;
"
- "asked for %lu bytes at %p. "
- "Try specifying an address with +RTS -xm<addr>
-RTS",
-diff --git a/rts/MemoryMap.c b/rts/MemoryMap.c
-new file mode 100644
-index 00000000000..99273b7dc69
---- /dev/null
-+++ b/rts/MemoryMap.c
-@@ -0,0 +1,138 @@
-+/* -----------------------------------------------------------------------------
-+ *
-+ * (c) The GHC Team, 1998-2004
-+ *
-+ * Memory-map dumping.
-+ *
-+ * This is intended to be used for reporting the process memory-map
-+ * in diagnostics when the RTS fails to map a block of memory.
-+ *
-+ * ---------------------------------------------------------------------------*/
-+
-+#include "PosixSource.h"
-+#include "Rts.h"
-+
-+#include <string.h>
-+
-+#if defined(darwin_HOST_OS)
-+#include <mach/mach.h>
-+#include <mach/mach_vm.h>
-+#include <mach/vm_region.h>
-+#include <mach/vm_statistics.h>
-+#endif
-+
-+#include "MemoryMap.h"
-+
-+#if defined(mingw32_HOST_OS)
-+
-+void reportMemoryMap() {
-+ debugBelch("\nMemory map:\n");
-+ uint8_t *addr = NULL;
-+ while (true) {
-+ MEMORY_BASIC_INFORMATION info;
-+ int res = VirtualQuery(addr, &info, sizeof(info));
-+ if (!res && GetLastError() == ERROR_INVALID_PARAMETER) {
-+ return;
-+ } else if (!res) {
-+ sysErrorBelch("VirtualQuery failed");
-+ return;
-+ }
-+
-+ if (info.State & MEM_FREE) {
-+ // free range
-+ } else {
-+ const char *protection;
-+ switch (info.Protect) {
-+ case PAGE_EXECUTE: protection = "--x"; break;
-+ case PAGE_EXECUTE_READ: protection = "r-x"; break;
-+ case PAGE_EXECUTE_READWRITE: protection = "rwx"; break;
-+ case PAGE_EXECUTE_WRITECOPY: protection = "rcx"; break;
-+ case PAGE_NOACCESS: protection = "---"; break;
-+ case PAGE_READONLY: protection = "r--"; break;
-+ case PAGE_READWRITE: protection = "rw-"; break;
-+ case PAGE_WRITECOPY: protection = "rc-"; break;
-+ default: protection = "???"; break;
-+ }
-+
-+ const char *type;
-+ switch (info.Type) {
-+ case MEM_IMAGE: type = "image"; break;
-+ case MEM_MAPPED: type = "mapped"; break;
-+ case MEM_PRIVATE: type = "private"; break;
-+ default: type = "unknown"; break;
-+ }
-+
-+ debugBelch("%08llx-%08llx %8zuK %3s (%s)\n",
-+ (uintptr_t) info.BaseAddress,
-+ (uintptr_t) info.BaseAddress + info.RegionSize,
-+ (size_t) info.RegionSize,
-+ protection, type);
-+ }
-+ addr = (uint8_t *) info.BaseAddress + info.RegionSize;
-+ }
-+}
-+
-+#elif defined(darwin_HOST_OS)
-+
-+void reportMemoryMap() {
-+ // Inspired by MacFUSE /proc implementation
-+ debugBelch("\nMemory map:\n");
-+ while (true) {
-+ vm_size_t vmsize;
-+ vm_address_t address;
-+ vm_region_basic_info_data_t info;
-+ vm_region_flavor_t flavor = VM_REGION_BASIC_INFO;
-+ memory_object_name_t object;
-+ mach_msg_type_number_t info_count = VM_REGION_BASIC_INFO_COUNT;
-+ kern_return_t kr =
-+ mach_vm_region(mach_task_self(), &address, &vmsize, flavor,
-+ (vm_region_info_t)&info, &info_count, &object);
-+ if (kr == KERN_SUCCESS) {
-+ debugBelch("%08lx-%08lx %8zuK %c%c%c/%c%c%c\n",
-+ address, (address + vmsize), (vmsize >> 10),
-+ (info.protection & VM_PROT_READ) ? 'r' :
'-',
-+ (info.protection & VM_PROT_WRITE) ? 'w' :
'-',
-+ (info.protection & VM_PROT_EXECUTE) ? 'x' :
'-',
-+ (info.max_protection & VM_PROT_READ) ? 'r' :
'-',
-+ (info.max_protection & VM_PROT_WRITE) ? 'w' :
'-',
-+ (info.max_protection & VM_PROT_EXECUTE) ? 'x' :
'-');
-+ address += vmsize;
-+ } else if (kr == KERN_INVALID_ADDRESS) {
-+ // We presumably reached the end of address space
-+ break;
-+ } else {
-+ debugBelch(" Error: %s\n", mach_error_string(kr));
-+ break;
-+ }
-+ }
-+}
-+
-+#else
-+
-+// Linux et al.
-+void reportMemoryMap() {
-+ debugBelch("\nMemory map:\n");
-+ FILE *f = fopen("/proc/self/maps", "r");
-+ if (f == NULL) {
-+ debugBelch(" Could not open /proc/self/maps\n");
-+ return;
-+ }
-+
-+ while (true) {
-+ char buf[256];
-+ size_t n = fread(buf, 1, sizeof(buf)-1, f);
-+ if (n <= 0) {
-+ debugBelch(" Error: %s\n", strerror(errno));
-+ break;
-+ }
-+ buf[n] = '\0';
-+ debugBelch("%s", buf);
-+ if (n < sizeof(buf)-1) {
-+ break;
-+ }
-+ }
-+ debugBelch("\n");
-+ fclose(f);
-+}
-+
-+#endif
-diff --git a/rts/MemoryMap.h b/rts/MemoryMap.h
-new file mode 100644
-index 00000000000..7d2c4a58b1d
---- /dev/null
-+++ b/rts/MemoryMap.h
-@@ -0,0 +1,13 @@
-+/* -----------------------------------------------------------------------------
-+ *
-+ * (c) The GHC Team, 1998-2004
-+ *
-+ * Memory-map dumping.
-+ *
-+ * This is intended to be used for reporting the process memory-map
-+ * in diagnostics when the RTS fails to map a block of memory.
-+ *
-+ * ---------------------------------------------------------------------------*/
-+
-+void reportMemoryMap(void);
-+
-diff --git a/rts/linker/M32Alloc.c b/rts/linker/M32Alloc.c
-index 46bf72f52ed..c0462d774b1 100644
---- a/rts/linker/M32Alloc.c
-+++ b/rts/linker/M32Alloc.c
-@@ -11,6 +11,7 @@
- #include "RtsUtils.h"
- #include "linker/M32Alloc.h"
- #include "LinkerInternals.h"
-+#include "MemoryMap.h"
-
- #include <inttypes.h>
- #include <stdlib.h>
-@@ -329,6 +330,7 @@ m32_alloc_page(void)
- const size_t map_sz = pgsz * M32_MAP_PAGES;
- uint8_t *chunk = mmapAnonForLinker(map_sz);
- if (! is_okay_address(chunk + map_sz)) {
-+ reportMemoryMap();
- barf("m32_alloc_page: failed to allocate pages within 4GB of program text
(got %p)", chunk);
- }
- IF_DEBUG(sanity, memset(chunk, 0xaa, map_sz));
-@@ -481,6 +483,7 @@ m32_alloc(struct m32_allocator_t *alloc, size_t size, size_t
alignment)
- sysErrorBelch("m32_alloc: Failed to map pages for %zd bytes",
size);
- return NULL;
- } else if (! is_okay_address(page)) {
-+ reportMemoryMap();
- barf("m32_alloc: warning: Allocation of %zd bytes resulted in pages above
4GB (%p)",
- size, page);
- }
-diff --git a/rts/rts.cabal.in b/rts/rts.cabal.in
-index a2acf27cb5b..ed93800e574 100644
---- a/rts/rts.cabal.in
-+++ b/rts/rts.cabal.in
-@@ -475,6 +475,7 @@ library
- Libdw.c
- LibdwPool.c
- Linker.c
-+ MemoryMap.c
- Messages.c
- OldARMAtomic.c
- PathUtils.c
---
-GitLab
-
-
-From 268fbed33274f1ec1c4ff02b1afe2c55a4a9916a Mon Sep 17 00:00:00 2001
-From: Ben Gamari <ben(a)smart-cactus.org>
-Date: Thu, 28 Apr 2022 23:03:32 -0400
-Subject: [PATCH 08/13] rts/m32: Fix assertion failure
-
-This fixes an assertion failure in the m32 allocator due to the
-imprecisely specified preconditions of `m32_allocator_push_filled_list`.
-Specifically, the caller must ensure that the page type is set to filled
-prior to calling `m32_allocator_push_filled_list`.
-
-While this issue did result in an assertion failure in the debug RTS,
-the issue is in fact benign.
-
-(cherry picked from commit 37825ce283b6dbcb532f51fade090a69afc2d078)
----
- rts/linker/M32Alloc.c | 3 +++
- 1 file changed, 3 insertions(+)
-
-diff --git a/rts/linker/M32Alloc.c b/rts/linker/M32Alloc.c
-index c0462d774b1..baec1039d5f 100644
---- a/rts/linker/M32Alloc.c
-+++ b/rts/linker/M32Alloc.c
-@@ -409,6 +409,8 @@ void m32_allocator_free(m32_allocator *alloc)
- static void
- m32_allocator_push_filled_list(struct m32_page_t **head, struct m32_page_t *page)
- {
-+ ASSERT_PAGE_TYPE(page, FILLED_PAGE);
-+ // N.B. it's the caller's responsibility to set the pagetype to FILLED_PAGE
- m32_filled_page_set_next(page, *head);
- *head = page;
- }
-@@ -525,6 +527,7 @@ m32_alloc(struct m32_allocator_t *alloc, size_t size, size_t
alignment)
-
- // If we haven't found an empty page, flush the most filled one
- if (empty == -1) {
-+ SET_PAGE_TYPE(alloc->pages[most_filled], FILLED_PAGE);
- m32_allocator_push_filled_list(&alloc->unprotected_list,
alloc->pages[most_filled]);
- alloc->pages[most_filled] = NULL;
- empty = most_filled;
---
-GitLab
-
-
-From c8733945501ca6622f091a6f696de139bc5669e5 Mon Sep 17 00:00:00 2001
-From: Ben Gamari <ben(a)smart-cactus.org>
-Date: Mon, 7 Feb 2022 16:15:41 -0500
-Subject: [PATCH 09/13] rts: Rename MemoryMap.[ch] -> ReportMemoryMap.[ch]
-
-(cherry picked from commit 3df06922f03191310ebee0547de1782eeb6bda67)
----
- rts/Linker.c | 2 +-
- rts/{MemoryMap.c => ReportMemoryMap.c} | 2 +-
- rts/{MemoryMap.h => ReportMemoryMap.h} | 0
- rts/linker/M32Alloc.c | 2 +-
- rts/rts.cabal.in | 2 +-
- 5 files changed, 4 insertions(+), 4 deletions(-)
- rename rts/{MemoryMap.c => ReportMemoryMap.c} (99%)
- rename rts/{MemoryMap.h => ReportMemoryMap.h} (100%)
-
-diff --git a/rts/Linker.c b/rts/Linker.c
-index 4a59f187f24..55f8621e2cd 100644
---- a/rts/Linker.c
-+++ b/rts/Linker.c
-@@ -33,7 +33,7 @@
- #include "linker/SymbolExtras.h"
- #include "PathUtils.h"
- #include "CheckUnload.h" // createOCSectionIndices
--#include "MemoryMap.h"
-+#include "ReportMemoryMap.h"
-
- #if !defined(mingw32_HOST_OS)
- #include "posix/Signals.h"
-diff --git a/rts/MemoryMap.c b/rts/ReportMemoryMap.c
-similarity index 99%
-rename from rts/MemoryMap.c
-rename to rts/ReportMemoryMap.c
-index 99273b7dc69..c30c80070ee 100644
---- a/rts/MemoryMap.c
-+++ b/rts/ReportMemoryMap.c
-@@ -21,7 +21,7 @@
- #include <mach/vm_statistics.h>
- #endif
-
--#include "MemoryMap.h"
-+#include "ReportMemoryMap.h"
-
- #if defined(mingw32_HOST_OS)
-
-diff --git a/rts/MemoryMap.h b/rts/ReportMemoryMap.h
-similarity index 100%
-rename from rts/MemoryMap.h
-rename to rts/ReportMemoryMap.h
-diff --git a/rts/linker/M32Alloc.c b/rts/linker/M32Alloc.c
-index baec1039d5f..b0a6ccfd58f 100644
---- a/rts/linker/M32Alloc.c
-+++ b/rts/linker/M32Alloc.c
-@@ -11,7 +11,7 @@
- #include "RtsUtils.h"
- #include "linker/M32Alloc.h"
- #include "LinkerInternals.h"
--#include "MemoryMap.h"
-+#include "ReportMemoryMap.h"
-
- #include <inttypes.h>
- #include <stdlib.h>
-diff --git a/rts/rts.cabal.in b/rts/rts.cabal.in
-index ed93800e574..77f3ee989dd 100644
---- a/rts/rts.cabal.in
-+++ b/rts/rts.cabal.in
-@@ -475,7 +475,7 @@ library
- Libdw.c
- LibdwPool.c
- Linker.c
-- MemoryMap.c
-+ ReportMemoryMap.c
- Messages.c
- OldARMAtomic.c
- PathUtils.c
---
-GitLab
-
-
-From 49e546b73bcef8cbab310685fd3d05f6b1d2a294 Mon Sep 17 00:00:00 2001
-From: Ben Gamari <ben(a)smart-cactus.org>
-Date: Mon, 7 Feb 2022 16:21:50 -0500
-Subject: [PATCH 10/13] rts: Move mmapForLinker and friends to linker/MMap.c
-
-They are not particularly related to linking.
-
-(cherry picked from commit e219ac826b05db833531028e0663f62f12eff010)
----
- rts/ExecPage.c | 2 +-
- rts/Linker.c | 252 +--------------------------------
- rts/LinkerInternals.h | 88 ------------
- rts/linker/Elf.c | 1 +
- rts/linker/LoadArchive.c | 1 +
- rts/linker/M32Alloc.c | 2 +-
- rts/linker/MMap.c | 290 ++++++++++++++++++++++++++++++++++++++
- rts/linker/MMap.h | 79 +++++++++++
- rts/linker/SymbolExtras.c | 1 +
- rts/linker/elf_got.c | 1 +
- rts/rts.cabal.in | 1 +
- 11 files changed, 377 insertions(+), 341 deletions(-)
- create mode 100644 rts/linker/MMap.c
- create mode 100644 rts/linker/MMap.h
-
-diff --git a/rts/ExecPage.c b/rts/ExecPage.c
-index 24d4d65bad4..0f83c8e1f59 100644
---- a/rts/ExecPage.c
-+++ b/rts/ExecPage.c
-@@ -6,8 +6,8 @@
- */
-
- #include "Rts.h"
--#include "LinkerInternals.h"
- #include "sm/OSMem.h"
-+#include "linker/MMap.h"
-
- ExecPage *allocateExecPage() {
- ExecPage *page = (ExecPage *) mmapAnonForLinker(getPageSize());
-diff --git a/rts/Linker.c b/rts/Linker.c
-index 55f8621e2cd..0d836a37a46 100644
---- a/rts/Linker.c
-+++ b/rts/Linker.c
-@@ -31,6 +31,7 @@
- #include "linker/M32Alloc.h"
- #include "linker/CacheFlush.h"
- #include "linker/SymbolExtras.h"
-+#include "linker/MMap.h"
- #include "PathUtils.h"
- #include "CheckUnload.h" // createOCSectionIndices
- #include "ReportMemoryMap.h"
-@@ -199,8 +200,6 @@ Mutex linker_mutex;
- /* Generic wrapper function to try and Resolve and RunInit oc files */
- int ocTryLoad( ObjectCode* oc );
-
--static void *mmap_32bit_base = LINKER_LOAD_BASE;
--
- static void ghciRemoveSymbolTable(StrHashTable *table, const SymbolName* key,
- ObjectCode *owner)
- {
-@@ -1049,255 +1048,6 @@ resolveSymbolAddr (pathchar* buffer, int size,
- #endif /* OBJFORMAT_PEi386 */
- }
-
--static const char *memoryAccessDescription(MemoryAccess mode)
--{
-- switch (mode) {
-- case MEM_NO_ACCESS: return "no-access";
-- case MEM_READ_ONLY: return "read-only";
-- case MEM_READ_WRITE: return "read-write";
-- case MEM_READ_EXECUTE: return "read-execute";
-- default: barf("invalid MemoryAccess");
-- }
--}
--
--#if defined(mingw32_HOST_OS)
--
--//
--// Returns NULL on failure.
--//
--void *
--mmapAnonForLinker (size_t bytes)
--{
-- return VirtualAlloc(NULL, bytes, MEM_COMMIT | MEM_RESERVE, PAGE_READWRITE);
--}
--
--void
--munmapForLinker (void *addr, size_t bytes, const char *caller)
--{
-- if (VirtualFree(addr, 0, MEM_RELEASE) == 0) {
-- sysErrorBelch("munmapForLinker: %s: Failed to unmap %zd bytes at %p",
-- caller, bytes, addr);
-- }
--}
--
--/**
-- * Change the allowed access modes of a region of memory previously allocated
-- * with mmapAnonForLinker.
-- */
--void
--mprotectForLinker(void *start, size_t len, MemoryAccess mode)
--{
-- DWORD old;
-- if (len == 0) {
-- return;
-- }
-- DWORD prot;
-- switch (mode) {
-- case MEM_NO_ACCESS: prot = PAGE_NOACCESS; break;
-- case MEM_READ_ONLY: prot = PAGE_READONLY; break;
-- case MEM_READ_WRITE: prot = PAGE_READWRITE; break;
-- case MEM_READ_EXECUTE: prot = PAGE_EXECUTE_READ; break;
-- default: barf("invalid MemoryAccess");
-- }
--
-- if (VirtualProtect(start, len, prot, &old) == 0) {
-- sysErrorBelch("mprotectForLinker: failed to protect %zd bytes at %p as
%s",
-- len, start, memoryAccessDescription(mode));
-- ASSERT(false);
-- }
--}
--
--#elif RTS_LINKER_USE_MMAP
--//
--// Returns NULL on failure.
--//
--void *
--mmapForLinker (size_t bytes, uint32_t prot, uint32_t flags, int fd, int offset)
--{
-- void *map_addr = NULL;
-- void *result;
-- size_t size;
-- uint32_t tryMap32Bit = RtsFlags.MiscFlags.linkerAlwaysPic
-- ? 0
-- : TRY_MAP_32BIT;
-- static uint32_t fixed = 0;
--
-- IF_DEBUG(linker, debugBelch("mmapForLinker: start\n"));
-- size = roundUpToPage(bytes);
--
--#if defined(MAP_LOW_MEM)
--mmap_again:
--#endif
--
-- if (mmap_32bit_base != NULL) {
-- map_addr = mmap_32bit_base;
-- }
--
-- IF_DEBUG(linker,
-- debugBelch("mmapForLinker: \tprotection %#0x\n", prot));
-- IF_DEBUG(linker,
-- debugBelch("mmapForLinker: \tflags %#0x\n",
-- MAP_PRIVATE | tryMap32Bit | fixed | flags));
-- IF_DEBUG(linker,
-- debugBelch("mmapForLinker: \tsize %#0zx\n", bytes));
-- IF_DEBUG(linker,
-- debugBelch("mmapForLinker: \tmap_addr %p\n", map_addr));
--
-- result = mmap(map_addr, size, prot,
-- MAP_PRIVATE|tryMap32Bit|fixed|flags, fd, offset);
--
-- if (result == MAP_FAILED) {
-- reportMemoryMap();
-- sysErrorBelch("mmap %" FMT_Word " bytes at
%p",(W_)size,map_addr);
-- errorBelch("Try specifying an address with +RTS -xm<addr>
-RTS");
-- return NULL;
-- }
--
--#if defined(MAP_LOW_MEM)
-- if (RtsFlags.MiscFlags.linkerAlwaysPic) {
-- /* make no attempt at mapping low memory if we are assuming PIC */
-- } else if (mmap_32bit_base != NULL) {
-- if (result != map_addr) {
-- if ((W_)result > 0x80000000) {
-- // oops, we were given memory over 2Gb
-- munmap(result,size);
--#if defined(freebsd_HOST_OS) || \
-- defined(kfreebsdgnu_HOST_OS) || \
-- defined(dragonfly_HOST_OS)
-- // Some platforms require MAP_FIXED. This is normally
-- // a bad idea, because MAP_FIXED will overwrite
-- // existing mappings.
-- fixed = MAP_FIXED;
-- goto mmap_again;
--#else
-- reportMemoryMap();
-- errorBelch("mmapForLinker: failed to mmap() memory below 2Gb;
"
-- "asked for %lu bytes at %p. "
-- "Try specifying an address with +RTS -xm<addr>
-RTS",
-- size, map_addr);
-- return NULL;
--#endif
-- } else {
-- // hmm, we were given memory somewhere else, but it's
-- // still under 2Gb so we can use it.
-- }
-- }
-- } else {
-- if ((W_)result > 0x80000000) {
-- // oops, we were given memory over 2Gb
-- // ... try allocating memory somewhere else?;
-- debugTrace(DEBUG_linker,
-- "MAP_32BIT didn't work; gave us %lu bytes at 0x%p",
-- bytes, result);
-- munmap(result, size);
--
-- // Set a base address and try again... (guess: 1Gb)
-- mmap_32bit_base = (void*)0x40000000;
-- goto mmap_again;
-- }
-- }
--#elif (defined(aarch64_TARGET_ARCH) || defined(aarch64_HOST_ARCH))
-- // for aarch64 we need to make sure we stay within 4GB of the
-- // mmap_32bit_base, and we also do not want to update it.
-- if (result != map_addr) {
-- // upper limit 4GB - size of the object file - 1mb wiggle room.
-- if(llabs((uintptr_t)result - (uintptr_t)&stg_upd_frame_info) >
(2<<32) - size - (2<<20)) {
-- // not within range :(
-- debugTrace(DEBUG_linker,
-- "MAP_32BIT didn't work; gave us %lu bytes at
0x%p",
-- bytes, result);
-- munmap(result, size);
-- // TODO: some abort/mmap_32bit_base recomputation based on
-- // if mmap_32bit_base is changed, or still at stg_upd_frame_info
-- goto mmap_again;
-- }
-- }
--#endif
--
-- if (mmap_32bit_base != NULL) {
-- // Next time, ask for memory right after our new mapping to maximize the
-- // chance that we get low memory.
-- mmap_32bit_base = (void*) ((uintptr_t)result + size);
-- }
--
-- IF_DEBUG(linker,
-- debugBelch("mmapForLinker: mapped %" FMT_Word
-- " bytes starting at %p\n", (W_)size, result));
-- IF_DEBUG(linker,
-- debugBelch("mmapForLinker: done\n"));
--
-- return result;
--}
--
--/*
-- * Map read/write pages in low memory. Returns NULL on failure.
-- */
--void *
--mmapAnonForLinker (size_t bytes)
--{
-- return mmapForLinker (bytes, PROT_READ|PROT_WRITE, MAP_ANONYMOUS, -1, 0);
--}
--
--void munmapForLinker (void *addr, size_t bytes, const char *caller)
--{
-- int r = munmap(addr, bytes);
-- if (r == -1) {
-- // Should we abort here?
-- sysErrorBelch("munmap: %s", caller);
-- }
--}
--
--/* Note [Memory protection in the linker]
-- * ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-- * For many years the linker would simply map all of its memory
-- * with PROT_READ|PROT_WRITE|PROT_EXEC. However operating systems have been
-- * becoming increasingly reluctant to accept this practice (e.g. #17353,
-- * #12657) and for good reason: writable code is ripe for exploitation.
-- *
-- * Consequently mmapForLinker now maps its memory with PROT_READ|PROT_WRITE.
-- * After the linker has finished filling/relocating the mapping it must then
-- * call mprotectForLinker on the sections of the mapping which
-- * contain executable code.
-- *
-- * Note that the m32 allocator handles protection of its allocations. For this
-- * reason the caller to m32_alloc() must tell the allocator whether the
-- * allocation needs to be executable. The caller must then ensure that they
-- * call m32_allocator_flush() after they are finished filling the region, which
-- * will cause the allocator to change the protection bits to
-- * PROT_READ|PROT_EXEC.
-- *
-- */
--
--/*
-- * Mark an portion of a mapping previously reserved by mmapForLinker
-- * as executable (but not writable).
-- */
--void mprotectForLinker(void *start, size_t len, MemoryAccess mode)
--{
-- if (len == 0) {
-- return;
-- }
-- IF_DEBUG(linker,
-- debugBelch("mprotectForLinker: protecting %" FMT_Word
-- " bytes starting at %p as %s\n",
-- (W_)len, start, memoryAccessDescription(mode)));
--
-- int prot;
-- switch (mode) {
-- case MEM_NO_ACCESS: prot = 0; break;
-- case MEM_READ_ONLY: prot = PROT_READ; break;
-- case MEM_READ_WRITE: prot = PROT_READ | PROT_WRITE; break;
-- case MEM_READ_EXECUTE: prot = PROT_READ | PROT_EXEC; break;
-- default: barf("invalid MemoryAccess");
-- }
--
-- if (mprotect(start, len, prot) == -1) {
-- sysErrorBelch("mprotectForLinker: failed to protect %zd bytes at %p as
%s",
-- len, start, memoryAccessDescription(mode));
-- }
--}
--#endif
--
- /*
- * Remove symbols from the symbol table, and free oc->symbols.
- * This operation is idempotent.
-diff --git a/rts/LinkerInternals.h b/rts/LinkerInternals.h
-index 3e6b3df9dab..ccda39b0cf0 100644
---- a/rts/LinkerInternals.h
-+++ b/rts/LinkerInternals.h
-@@ -374,19 +374,6 @@ void exitLinker( void );
- void freeObjectCode (ObjectCode *oc);
- SymbolAddr* loadSymbol(SymbolName *lbl, RtsSymbolInfo *pinfo);
-
--/** Access modes for mprotectForLinker */
--typedef enum {
-- MEM_NO_ACCESS,
-- MEM_READ_ONLY,
-- MEM_READ_WRITE,
-- MEM_READ_EXECUTE,
--} MemoryAccess;
--
--void *mmapAnonForLinker (size_t bytes);
--void *mmapForLinker (size_t bytes, uint32_t prot, uint32_t flags, int fd, int offset);
--void mprotectForLinker(void *start, size_t len, MemoryAccess mode);
--void munmapForLinker (void *addr, size_t bytes, const char *caller);
--
- void addProddableBlock ( ObjectCode* oc, void* start, int size );
- void checkProddableBlock (ObjectCode *oc, void *addr, size_t size );
- void freeProddableBlocks (ObjectCode *oc);
-@@ -441,65 +428,6 @@ resolveSymbolAddr (pathchar* buffer, int size,
- #define USE_CONTIGUOUS_MMAP 0
- #endif
-
--/* Link objects into the lower 2Gb on x86_64 and AArch64. GHC assumes the
-- * small memory model on this architecture (see gcc docs,
-- * -mcmodel=small).
-- *
-- * MAP_32BIT not available on OpenBSD/amd64
-- */
--#if defined(MAP_32BIT) && (defined(x86_64_HOST_ARCH) ||
(defined(aarch64_TARGET_ARCH) || defined(aarch64_HOST_ARCH)))
--#define MAP_LOW_MEM
--#define TRY_MAP_32BIT MAP_32BIT
--#else
--#define TRY_MAP_32BIT 0
--#endif
--
--#if defined(aarch64_HOST_ARCH)
--// On AArch64 MAP_32BIT is not available but we are still bound by the small
--// memory model. Consequently we still try using the MAP_LOW_MEM allocation
--// strategy.
--#define MAP_LOW_MEM
--#endif
--
--/*
-- * Note [MAP_LOW_MEM]
-- * ~~~~~~~~~~~~~~~~~~
-- * Due to the small memory model (see above), on x86_64 and AArch64 we have to
-- * map all our non-PIC object files into the low 2Gb of the address space (why
-- * 2Gb and not 4Gb? Because all addresses must be reachable using a 32-bit
-- * signed PC-relative offset). On x86_64 Linux we can do this using the
-- * MAP_32BIT flag to mmap(), however on other OSs (e.g. *BSD, see #2063, and
-- * also on Linux inside Xen, see #2512), we can't do this. So on these
-- * systems, we have to pick a base address in the low 2Gb of the address space
-- * and try to allocate memory from there.
-- *
-- * The same holds for aarch64, where the default, even with PIC, model
-- * is 4GB. The linker is free to emit AARCH64_ADR_PREL_PG_HI21
-- * relocations.
-- *
-- * We pick a default address based on the OS, but also make this
-- * configurable via an RTS flag (+RTS -xm)
-- */
--
--#if defined(aarch64_TARGET_ARCH) || defined(aarch64_HOST_ARCH)
--// Try to use stg_upd_frame_info as the base. We need to be within +-4GB of that
--// address, otherwise we violate the aarch64 memory model. Any object we load
--// can potentially reference any of the ones we bake into the binary (and list)
--// in RtsSymbols. Thus we'll need to be within +-4GB of those,
--// stg_upd_frame_info is a good candidate as it's referenced often.
--#define LINKER_LOAD_BASE ((void *) &stg_upd_frame_info)
--#elif defined(x86_64_HOST_ARCH) && defined(mingw32_HOST_OS)
--// On Windows (which now uses high-entropy ASLR by default) we need to ensure
--// that we map code near the executable image. We use stg_upd_frame_info as a
--// proxy for the image location.
--#define LINKER_LOAD_BASE ((void *) &stg_upd_frame_info)
--#elif defined(MAP_32BIT) || DEFAULT_LINKER_ALWAYS_PIC
--// Try to use MAP_32BIT
--#define LINKER_LOAD_BASE ((void *) 0x0)
--#else
--// A guess: 1 GB.
--#define LINKER_LOAD_BASE ((void *) 0x40000000)
--#endif
-
- HsInt isAlreadyLoaded( pathchar *path );
- OStatus getObjectLoadStatus_ (pathchar *path);
-@@ -512,20 +440,4 @@ ObjectCode* mkOc( ObjectType type, pathchar *path, char *image, int
imageSize,
- void initSegment(Segment *s, void *start, size_t size, SegmentProt prot, int
n_sections);
- void freeSegments(ObjectCode *oc);
-
--/* MAP_ANONYMOUS is MAP_ANON on some systems,
-- e.g. OS X (before Sierra), OpenBSD etc */
--#if !defined(MAP_ANONYMOUS) && defined(MAP_ANON)
--#define MAP_ANONYMOUS MAP_ANON
--#endif
--
--/* In order to simplify control flow a bit, some references to mmap-related
-- definitions are blocked off by a C-level if statement rather than a CPP-level
-- #if statement. Since those are dead branches when !RTS_LINKER_USE_MMAP, we
-- just stub out the relevant symbols here
--*/
--#if !RTS_LINKER_USE_MMAP
--#define munmap(x,y) /* nothing */
--#define MAP_ANONYMOUS 0
--#endif
--
- #include "EndPrivate.h"
-diff --git a/rts/linker/Elf.c b/rts/linker/Elf.c
-index 980d4b80f05..9956114264e 100644
---- a/rts/linker/Elf.c
-+++ b/rts/linker/Elf.c
-@@ -17,6 +17,7 @@
- #include "RtsSymbolInfo.h"
- #include "CheckUnload.h"
- #include "LinkerInternals.h"
-+#include "linker/MMap.h"
- #include "linker/Elf.h"
- #include "linker/CacheFlush.h"
- #include "linker/M32Alloc.h"
-diff --git a/rts/linker/LoadArchive.c b/rts/linker/LoadArchive.c
-index 041ebef4b61..f9282f197ff 100644
---- a/rts/linker/LoadArchive.c
-+++ b/rts/linker/LoadArchive.c
-@@ -7,6 +7,7 @@
- #include "LinkerInternals.h"
- #include "CheckUnload.h" // loaded_objects, insertOCSectionIndices
- #include "linker/M32Alloc.h"
-+#include "linker/MMap.h"
-
- /* Platform specific headers */
- #if defined(OBJFORMAT_PEi386)
-diff --git a/rts/linker/M32Alloc.c b/rts/linker/M32Alloc.c
-index b0a6ccfd58f..2592599d92b 100644
---- a/rts/linker/M32Alloc.c
-+++ b/rts/linker/M32Alloc.c
-@@ -10,7 +10,7 @@
- #include "sm/OSMem.h"
- #include "RtsUtils.h"
- #include "linker/M32Alloc.h"
--#include "LinkerInternals.h"
-+#include "linker/MMap.h"
- #include "ReportMemoryMap.h"
-
- #include <inttypes.h>
-diff --git a/rts/linker/MMap.c b/rts/linker/MMap.c
-new file mode 100644
-index 00000000000..c2edf78fd14
---- /dev/null
-+++ b/rts/linker/MMap.c
-@@ -0,0 +1,290 @@
-+#include "Rts.h"
-+
-+#include "sm/OSMem.h"
-+#include "linker/MMap.h"
-+#include "Trace.h"
-+#include "ReportMemoryMap.h"
-+
-+#if RTS_LINKER_USE_MMAP
-+#include <sys/mman.h>
-+#endif
-+
-+/* Link objects into the lower 2Gb on x86_64 and AArch64. GHC assumes the
-+ * small memory model on this architecture (see gcc docs,
-+ * -mcmodel=small).
-+ *
-+ * MAP_32BIT not available on OpenBSD/amd64
-+ */
-+#if defined(MAP_32BIT) && (defined(x86_64_HOST_ARCH) ||
(defined(aarch64_TARGET_ARCH) || defined(aarch64_HOST_ARCH)))
-+#define MAP_LOW_MEM
-+#define TRY_MAP_32BIT MAP_32BIT
-+#else
-+#define TRY_MAP_32BIT 0
-+#endif
-+
-+/* MAP_ANONYMOUS is MAP_ANON on some systems,
-+ e.g. OS X (before Sierra), OpenBSD etc */
-+#if !defined(MAP_ANONYMOUS) && defined(MAP_ANON)
-+#define MAP_ANONYMOUS MAP_ANON
-+#endif
-+
-+/* In order to simplify control flow a bit, some references to mmap-related
-+ definitions are blocked off by a C-level if statement rather than a CPP-level
-+ #if statement. Since those are dead branches when !RTS_LINKER_USE_MMAP, we
-+ just stub out the relevant symbols here
-+*/
-+#if !RTS_LINKER_USE_MMAP
-+#define munmap(x,y) /* nothing */
-+#define MAP_ANONYMOUS 0
-+#endif
-+
-+void *mmap_32bit_base = LINKER_LOAD_BASE;
-+
-+static const char *memoryAccessDescription(MemoryAccess mode)
-+{
-+ switch (mode) {
-+ case MEM_NO_ACCESS: return "no-access";
-+ case MEM_READ_ONLY: return "read-only";
-+ case MEM_READ_WRITE: return "read-write";
-+ case MEM_READ_EXECUTE: return "read-execute";
-+ default: barf("invalid MemoryAccess");
-+ }
-+}
-+
-+#if defined(mingw32_HOST_OS)
-+
-+//
-+// Returns NULL on failure.
-+//
-+void *
-+mmapAnonForLinker (size_t bytes)
-+{
-+ return VirtualAlloc(NULL, bytes, MEM_COMMIT | MEM_RESERVE, PAGE_READWRITE);
-+}
-+
-+void
-+munmapForLinker (void *addr, size_t bytes, const char *caller)
-+{
-+ if (VirtualFree(addr, 0, MEM_RELEASE) == 0) {
-+ sysErrorBelch("munmapForLinker: %s: Failed to unmap %zd bytes at %p",
-+ caller, bytes, addr);
-+ }
-+}
-+
-+/**
-+ * Change the allowed access modes of a region of memory previously allocated
-+ * with mmapAnonForLinker.
-+ */
-+void
-+mprotectForLinker(void *start, size_t len, MemoryAccess mode)
-+{
-+ DWORD old;
-+ if (len == 0) {
-+ return;
-+ }
-+ DWORD prot;
-+ switch (mode) {
-+ case MEM_NO_ACCESS: prot = PAGE_NOACCESS; break;
-+ case MEM_READ_ONLY: prot = PAGE_READONLY; break;
-+ case MEM_READ_WRITE: prot = PAGE_READWRITE; break;
-+ case MEM_READ_EXECUTE: prot = PAGE_EXECUTE_READ; break;
-+ default: barf("invalid MemoryAccess");
-+ }
-+
-+ if (VirtualProtect(start, len, prot, &old) == 0) {
-+ sysErrorBelch("mprotectForLinker: failed to protect %zd bytes at %p as
%s",
-+ len, start, memoryAccessDescription(mode));
-+ ASSERT(false);
-+ }
-+}
-+
-+#elif RTS_LINKER_USE_MMAP
-+//
-+// Returns NULL on failure.
-+//
-+void *
-+mmapForLinker (size_t bytes, uint32_t prot, uint32_t flags, int fd, int offset)
-+{
-+ void *map_addr = NULL;
-+ void *result;
-+ size_t size;
-+ uint32_t tryMap32Bit = RtsFlags.MiscFlags.linkerAlwaysPic
-+ ? 0
-+ : TRY_MAP_32BIT;
-+ static uint32_t fixed = 0;
-+
-+ IF_DEBUG(linker, debugBelch("mmapForLinker: start\n"));
-+ size = roundUpToPage(bytes);
-+
-+#if defined(MAP_LOW_MEM)
-+mmap_again:
-+#endif
-+
-+ if (mmap_32bit_base != NULL) {
-+ map_addr = mmap_32bit_base;
-+ }
-+
-+ IF_DEBUG(linker,
-+ debugBelch("mmapForLinker: \tprotection %#0x\n", prot));
-+ IF_DEBUG(linker,
-+ debugBelch("mmapForLinker: \tflags %#0x\n",
-+ MAP_PRIVATE | tryMap32Bit | fixed | flags));
-+ IF_DEBUG(linker,
-+ debugBelch("mmapForLinker: \tsize %#0zx\n", bytes));
-+ IF_DEBUG(linker,
-+ debugBelch("mmapForLinker: \tmap_addr %p\n", map_addr));
-+
-+ result = mmap(map_addr, size, prot,
-+ MAP_PRIVATE|tryMap32Bit|fixed|flags, fd, offset);
-+
-+ if (result == MAP_FAILED) {
-+ reportMemoryMap();
-+ sysErrorBelch("mmap %" FMT_Word " bytes at
%p",(W_)size,map_addr);
-+ errorBelch("Try specifying an address with +RTS -xm<addr>
-RTS");
-+ return NULL;
-+ }
-+
-+#if defined(MAP_LOW_MEM)
-+ if (RtsFlags.MiscFlags.linkerAlwaysPic) {
-+ /* make no attempt at mapping low memory if we are assuming PIC */
-+ } else if (mmap_32bit_base != NULL) {
-+ if (result != map_addr) {
-+ if ((W_)result > 0x80000000) {
-+ // oops, we were given memory over 2Gb
-+ munmap(result,size);
-+#if defined(freebsd_HOST_OS) || \
-+ defined(kfreebsdgnu_HOST_OS) || \
-+ defined(dragonfly_HOST_OS)
-+ // Some platforms require MAP_FIXED. This is normally
-+ // a bad idea, because MAP_FIXED will overwrite
-+ // existing mappings.
-+ fixed = MAP_FIXED;
-+ goto mmap_again;
-+#else
-+ reportMemoryMap();
-+ errorBelch("mmapForLinker: failed to mmap() memory below 2Gb;
"
-+ "asked for %lu bytes at %p. "
-+ "Try specifying an address with +RTS -xm<addr>
-RTS",
-+ size, map_addr);
-+ return NULL;
-+#endif
-+ } else {
-+ // hmm, we were given memory somewhere else, but it's
-+ // still under 2Gb so we can use it.
-+ }
-+ }
-+ } else {
-+ if ((W_)result > 0x80000000) {
-+ // oops, we were given memory over 2Gb
-+ // ... try allocating memory somewhere else?;
-+ debugTrace(DEBUG_linker,
-+ "MAP_32BIT didn't work; gave us %lu bytes at 0x%p",
-+ bytes, result);
-+ munmap(result, size);
-+
-+ // Set a base address and try again... (guess: 1Gb)
-+ mmap_32bit_base = (void*)0x40000000;
-+ goto mmap_again;
-+ }
-+ }
-+#elif (defined(aarch64_TARGET_ARCH) || defined(aarch64_HOST_ARCH))
-+ // for aarch64 we need to make sure we stay within 4GB of the
-+ // mmap_32bit_base, and we also do not want to update it.
-+ if (result != map_addr) {
-+ // upper limit 4GB - size of the object file - 1mb wiggle room.
-+ if(llabs((uintptr_t)result - (uintptr_t)&stg_upd_frame_info) >
(2<<32) - size - (2<<20)) {
-+ // not within range :(
-+ debugTrace(DEBUG_linker,
-+ "MAP_32BIT didn't work; gave us %lu bytes at
0x%p",
-+ bytes, result);
-+ munmap(result, size);
-+ // TODO: some abort/mmap_32bit_base recomputation based on
-+ // if mmap_32bit_base is changed, or still at stg_upd_frame_info
-+ goto mmap_again;
-+ }
-+ }
-+#endif
-+
-+ if (mmap_32bit_base != NULL) {
-+ // Next time, ask for memory right after our new mapping to maximize the
-+ // chance that we get low memory.
-+ mmap_32bit_base = (void*) ((uintptr_t)result + size);
-+ }
-+
-+ IF_DEBUG(linker,
-+ debugBelch("mmapForLinker: mapped %" FMT_Word
-+ " bytes starting at %p\n", (W_)size, result));
-+ IF_DEBUG(linker,
-+ debugBelch("mmapForLinker: done\n"));
-+
-+ return result;
-+}
-+
-+/*
-+ * Map read/write pages in low memory. Returns NULL on failure.
-+ */
-+void *
-+mmapAnonForLinker (size_t bytes)
-+{
-+ return mmapForLinker (bytes, PROT_READ|PROT_WRITE, MAP_ANONYMOUS, -1, 0);
-+}
-+
-+void munmapForLinker (void *addr, size_t bytes, const char *caller)
-+{
-+ int r = munmap(addr, bytes);
-+ if (r == -1) {
-+ // Should we abort here?
-+ sysErrorBelch("munmap: %s", caller);
-+ }
-+}
-+
-+/* Note [Memory protection in the linker]
-+ * ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-+ * For many years the linker would simply map all of its memory
-+ * with PROT_READ|PROT_WRITE|PROT_EXEC. However operating systems have been
-+ * becoming increasingly reluctant to accept this practice (e.g. #17353,
-+ * #12657) and for good reason: writable code is ripe for exploitation.
-+ *
-+ * Consequently mmapForLinker now maps its memory with PROT_READ|PROT_WRITE.
-+ * After the linker has finished filling/relocating the mapping it must then
-+ * call mprotectForLinker on the sections of the mapping which
-+ * contain executable code.
-+ *
-+ * Note that the m32 allocator handles protection of its allocations. For this
-+ * reason the caller to m32_alloc() must tell the allocator whether the
-+ * allocation needs to be executable. The caller must then ensure that they
-+ * call m32_allocator_flush() after they are finished filling the region, which
-+ * will cause the allocator to change the protection bits to
-+ * PROT_READ|PROT_EXEC.
-+ *
-+ */
-+
-+/*
-+ * Mark an portion of a mapping previously reserved by mmapForLinker
-+ * as executable (but not writable).
-+ */
-+void mprotectForLinker(void *start, size_t len, MemoryAccess mode)
-+{
-+ if (len == 0) {
-+ return;
-+ }
-+ IF_DEBUG(linker,
-+ debugBelch("mprotectForLinker: protecting %" FMT_Word
-+ " bytes starting at %p as %s\n",
-+ (W_)len, start, memoryAccessDescription(mode)));
-+
-+ int prot;
-+ switch (mode) {
-+ case MEM_NO_ACCESS: prot = 0; break;
-+ case MEM_READ_ONLY: prot = PROT_READ; break;
-+ case MEM_READ_WRITE: prot = PROT_READ | PROT_WRITE; break;
-+ case MEM_READ_EXECUTE: prot = PROT_READ | PROT_EXEC; break;
-+ default: barf("invalid MemoryAccess");
-+ }
-+
-+ if (mprotect(start, len, prot) == -1) {
-+ sysErrorBelch("mprotectForLinker: failed to protect %zd bytes at %p as
%s",
-+ len, start, memoryAccessDescription(mode));
-+ }
-+}
-+#endif
-diff --git a/rts/linker/MMap.h b/rts/linker/MMap.h
-new file mode 100644
-index 00000000000..ed0baa68998
---- /dev/null
-+++ b/rts/linker/MMap.h
-@@ -0,0 +1,79 @@
-+#pragma once
-+
-+#include "BeginPrivate.h"
-+
-+#if defined(aarch64_HOST_ARCH)
-+// On AArch64 MAP_32BIT is not available but we are still bound by the small
-+// memory model. Consequently we still try using the MAP_LOW_MEM allocation
-+// strategy.
-+#define MAP_LOW_MEM
-+#endif
-+
-+/*
-+ * Note [MAP_LOW_MEM]
-+ * ~~~~~~~~~~~~~~~~~~
-+ * Due to the small memory model (see above), on x86_64 and AArch64 we have to
-+ * map all our non-PIC object files into the low 2Gb of the address space (why
-+ * 2Gb and not 4Gb? Because all addresses must be reachable using a 32-bit
-+ * signed PC-relative offset). On x86_64 Linux we can do this using the
-+ * MAP_32BIT flag to mmap(), however on other OSs (e.g. *BSD, see #2063, and
-+ * also on Linux inside Xen, see #2512), we can't do this. So on these
-+ * systems, we have to pick a base address in the low 2Gb of the address space
-+ * and try to allocate memory from there.
-+ *
-+ * The same holds for aarch64, where the default, even with PIC, model
-+ * is 4GB. The linker is free to emit AARCH64_ADR_PREL_PG_HI21
-+ * relocations.
-+ *
-+ * We pick a default address based on the OS, but also make this
-+ * configurable via an RTS flag (+RTS -xm)
-+ */
-+
-+#if defined(aarch64_TARGET_ARCH) || defined(aarch64_HOST_ARCH)
-+// Try to use stg_upd_frame_info as the base. We need to be within +-4GB of that
-+// address, otherwise we violate the aarch64 memory model. Any object we load
-+// can potentially reference any of the ones we bake into the binary (and list)
-+// in RtsSymbols. Thus we'll need to be within +-4GB of those,
-+// stg_upd_frame_info is a good candidate as it's referenced often.
-+#define LINKER_LOAD_BASE ((void *) &stg_upd_frame_info)
-+#elif defined(x86_64_HOST_ARCH) && defined(mingw32_HOST_OS)
-+// On Windows (which now uses high-entropy ASLR by default) we need to ensure
-+// that we map code near the executable image. We use stg_upd_frame_info as a
-+// proxy for the image location.
-+#define LINKER_LOAD_BASE ((void *) &stg_upd_frame_info)
-+#elif defined(MAP_32BIT) || DEFAULT_LINKER_ALWAYS_PIC
-+// Try to use MAP_32BIT
-+#define LINKER_LOAD_BASE ((void *) 0x0)
-+#else
-+// A guess: 1 GB.
-+#define LINKER_LOAD_BASE ((void *) 0x40000000)
-+#endif
-+
-+/** Access modes for mprotectForLinker */
-+typedef enum {
-+ MEM_NO_ACCESS,
-+ MEM_READ_ONLY,
-+ MEM_READ_WRITE,
-+ MEM_READ_EXECUTE,
-+} MemoryAccess;
-+
-+extern void *mmap_32bit_base;
-+
-+// Map read/write anonymous memory.
-+void *mmapAnonForLinker (size_t bytes);
-+
-+// Change protection of previous mapping memory.
-+void mprotectForLinker(void *start, size_t len, MemoryAccess mode);
-+
-+// Release a mapping.
-+void munmapForLinker (void *addr, size_t bytes, const char *caller);
-+
-+#if !defined(mingw32_HOST_OS)
-+// Map a file.
-+//
-+// Note that this not available on Windows since file mapping on Windows is
-+// sufficiently different to warrant its own interface.
-+void *mmapForLinker (size_t bytes, uint32_t prot, uint32_t flags, int fd, int offset);
-+#endif
-+
-+#include "EndPrivate.h"
-diff --git a/rts/linker/SymbolExtras.c b/rts/linker/SymbolExtras.c
-index 5c04e9b3a87..88192d43d9c 100644
---- a/rts/linker/SymbolExtras.c
-+++ b/rts/linker/SymbolExtras.c
-@@ -10,6 +10,7 @@
- */
-
- #include "LinkerInternals.h"
-+#include "linker/MMap.h"
-
- #if defined(NEED_SYMBOL_EXTRAS)
- #if !defined(x86_64_HOST_ARCH) || !defined(mingw32_HOST_OS)
-diff --git a/rts/linker/elf_got.c b/rts/linker/elf_got.c
-index ae75329295b..eefdae34c68 100644
---- a/rts/linker/elf_got.c
-+++ b/rts/linker/elf_got.c
-@@ -1,5 +1,6 @@
- #include "Rts.h"
- #include "elf_got.h"
-+#include "linker/MMap.h"
-
- #include <string.h>
-
-diff --git a/rts/rts.cabal.in b/rts/rts.cabal.in
-index 77f3ee989dd..0a06414d95f 100644
---- a/rts/rts.cabal.in
-+++ b/rts/rts.cabal.in
-@@ -533,6 +533,7 @@ library
- linker/Elf.c
- linker/LoadArchive.c
- linker/M32Alloc.c
-+ linker/MMap.c
- linker/MachO.c
- linker/macho/plt.c
- linker/macho/plt_aarch64.c
---
-GitLab
-
-
-From 6deb4d0de5428e85446f2a6312dac9b23d69bca8 Mon Sep 17 00:00:00 2001
-From: Ben Gamari <ben(a)smart-cactus.org>
-Date: Mon, 7 Feb 2022 19:56:22 -0500
-Subject: [PATCH 11/13] rts/linker/MMap: Use MemoryAccess in mmapForLinker
-
-(cherry picked from commit 4d3a306dce59649b303ac7aba56758aff3dee077)
----
- rts/Linker.c | 5 ++---
- rts/linker/Elf.c | 2 +-
- rts/linker/MMap.c | 54 ++++++++++++++++++++++++++++++----------------
- rts/linker/MMap.h | 3 ++-
- rts/linker/MachO.c | 2 +-
- 5 files changed, 42 insertions(+), 24 deletions(-)
-
-diff --git a/rts/Linker.c b/rts/Linker.c
-index 0d836a37a46..9754bf9f4f2 100644
---- a/rts/Linker.c
-+++ b/rts/Linker.c
-@@ -1353,10 +1353,9 @@ preloadObjectFile (pathchar *path)
- * See also the misalignment logic for darwin below.
- */
- #if defined(darwin_HOST_OS) || defined(openbsd_HOST_OS)
-- image = mmapForLinker(fileSize, PROT_READ|PROT_WRITE, MAP_PRIVATE, fd, 0);
-+ image = mmapForLinker(fileSize, MEM_READ_WRITE, MAP_PRIVATE, fd, 0);
- #else
-- image = mmapForLinker(fileSize, PROT_READ|PROT_WRITE|PROT_EXEC,
-- MAP_PRIVATE, fd, 0);
-+ image = mmapForLinker(fileSize, MEM_READ_WRITE_EXECUTE, MAP_PRIVATE, fd, 0);
- #endif
-
- if (image == MAP_FAILED) {
-diff --git a/rts/linker/Elf.c b/rts/linker/Elf.c
-index 9956114264e..9ae8b43cc4d 100644
---- a/rts/linker/Elf.c
-+++ b/rts/linker/Elf.c
-@@ -653,7 +653,7 @@ mapObjectFileSection (int fd, Elf_Word offset, Elf_Word size,
-
- pageOffset = roundDownToPage(offset);
- pageSize = roundUpToPage(offset-pageOffset+size);
-- p = mmapForLinker(pageSize, PROT_READ | PROT_WRITE, 0, fd, pageOffset);
-+ p = mmapForLinker(pageSize, MEM_READ_WRITE, 0, fd, pageOffset);
- if (p == NULL) return NULL;
- *mapped_size = pageSize;
- *mapped_offset = pageOffset;
-diff --git a/rts/linker/MMap.c b/rts/linker/MMap.c
-index c2edf78fd14..6226609604e 100644
---- a/rts/linker/MMap.c
-+++ b/rts/linker/MMap.c
-@@ -47,12 +47,28 @@ static const char *memoryAccessDescription(MemoryAccess mode)
- case MEM_READ_ONLY: return "read-only";
- case MEM_READ_WRITE: return "read-write";
- case MEM_READ_EXECUTE: return "read-execute";
-+ case MEM_READ_WRITE_EXECUTE:
-+ return "read-write-execute";
- default: barf("invalid MemoryAccess");
- }
- }
-
- #if defined(mingw32_HOST_OS)
-
-+static DWORD
-+memoryAccessToProt(MemoryAccess access)
-+{
-+ switch (access) {
-+ case MEM_NO_ACCESS: return PAGE_NOACCESS;
-+ case MEM_READ_ONLY: return PAGE_READONLY;
-+ case MEM_READ_WRITE: return PAGE_READWRITE;
-+ case MEM_READ_EXECUTE: return PAGE_EXECUTE_READ;
-+ case MEM_READ_WRITE_EXECUTE:
-+ return PAGE_EXECUTE_READWRITE;
-+ default: barf("invalid MemoryAccess");
-+ }
-+}
-+
- //
- // Returns NULL on failure.
- //
-@@ -82,14 +98,7 @@ mprotectForLinker(void *start, size_t len, MemoryAccess mode)
- if (len == 0) {
- return;
- }
-- DWORD prot;
-- switch (mode) {
-- case MEM_NO_ACCESS: prot = PAGE_NOACCESS; break;
-- case MEM_READ_ONLY: prot = PAGE_READONLY; break;
-- case MEM_READ_WRITE: prot = PAGE_READWRITE; break;
-- case MEM_READ_EXECUTE: prot = PAGE_EXECUTE_READ; break;
-- default: barf("invalid MemoryAccess");
-- }
-+ DWORD prot = memoryAccessToProt(mode);
-
- if (VirtualProtect(start, len, prot, &old) == 0) {
- sysErrorBelch("mprotectForLinker: failed to protect %zd bytes at %p as
%s",
-@@ -99,11 +108,26 @@ mprotectForLinker(void *start, size_t len, MemoryAccess mode)
- }
-
- #elif RTS_LINKER_USE_MMAP
-+
-+static int
-+memoryAccessToProt(MemoryAccess access)
-+{
-+ switch (access) {
-+ case MEM_NO_ACCESS: return 0;
-+ case MEM_READ_ONLY: return PROT_READ;
-+ case MEM_READ_WRITE: return PROT_READ | PROT_WRITE;
-+ case MEM_READ_EXECUTE: return PROT_READ | PROT_EXEC;
-+ case MEM_READ_WRITE_EXECUTE:
-+ return PROT_READ | PROT_WRITE | PROT_EXEC;
-+ default: barf("invalid MemoryAccess");
-+ }
-+}
-+
- //
- // Returns NULL on failure.
- //
- void *
--mmapForLinker (size_t bytes, uint32_t prot, uint32_t flags, int fd, int offset)
-+mmapForLinker (size_t bytes, MemoryAccess access, uint32_t flags, int fd, int offset)
- {
- void *map_addr = NULL;
- void *result;
-@@ -112,6 +136,7 @@ mmapForLinker (size_t bytes, uint32_t prot, uint32_t flags, int fd,
int offset)
- ? 0
- : TRY_MAP_32BIT;
- static uint32_t fixed = 0;
-+ int prot = memoryAccessToProt(access);
-
- IF_DEBUG(linker, debugBelch("mmapForLinker: start\n"));
- size = roundUpToPage(bytes);
-@@ -226,7 +251,7 @@ mmap_again:
- void *
- mmapAnonForLinker (size_t bytes)
- {
-- return mmapForLinker (bytes, PROT_READ|PROT_WRITE, MAP_ANONYMOUS, -1, 0);
-+ return mmapForLinker (bytes, MEM_READ_WRITE, MAP_ANONYMOUS, -1, 0);
- }
-
- void munmapForLinker (void *addr, size_t bytes, const char *caller)
-@@ -273,14 +298,7 @@ void mprotectForLinker(void *start, size_t len, MemoryAccess mode)
- " bytes starting at %p as %s\n",
- (W_)len, start, memoryAccessDescription(mode)));
-
-- int prot;
-- switch (mode) {
-- case MEM_NO_ACCESS: prot = 0; break;
-- case MEM_READ_ONLY: prot = PROT_READ; break;
-- case MEM_READ_WRITE: prot = PROT_READ | PROT_WRITE; break;
-- case MEM_READ_EXECUTE: prot = PROT_READ | PROT_EXEC; break;
-- default: barf("invalid MemoryAccess");
-- }
-+ int prot = memoryAccessToProt(mode);
-
- if (mprotect(start, len, prot) == -1) {
- sysErrorBelch("mprotectForLinker: failed to protect %zd bytes at %p as
%s",
-diff --git a/rts/linker/MMap.h b/rts/linker/MMap.h
-index ed0baa68998..9eebc3c4b20 100644
---- a/rts/linker/MMap.h
-+++ b/rts/linker/MMap.h
-@@ -55,6 +55,7 @@ typedef enum {
- MEM_READ_ONLY,
- MEM_READ_WRITE,
- MEM_READ_EXECUTE,
-+ MEM_READ_WRITE_EXECUTE,
- } MemoryAccess;
-
- extern void *mmap_32bit_base;
-@@ -73,7 +74,7 @@ void munmapForLinker (void *addr, size_t bytes, const char *caller);
- //
- // Note that this not available on Windows since file mapping on Windows is
- // sufficiently different to warrant its own interface.
--void *mmapForLinker (size_t bytes, uint32_t prot, uint32_t flags, int fd, int offset);
-+void *mmapForLinker (size_t bytes, MemoryAccess prot, uint32_t flags, int fd, int
offset);
- #endif
-
- #include "EndPrivate.h"
-diff --git a/rts/linker/MachO.c b/rts/linker/MachO.c
-index d037c82f458..805731ba56c 100644
---- a/rts/linker/MachO.c
-+++ b/rts/linker/MachO.c
-@@ -1210,7 +1210,7 @@ ocGetNames_MachO(ObjectCode* oc)
- unsigned nstubs = numberOfStubsForSection(oc, sec_idx);
- unsigned stub_space = STUB_SIZE * nstubs;
-
-- void * mem = mmapForLinker(section->size+stub_space, PROT_READ |
PROT_WRITE, MAP_ANON, -1, 0);
-+ void * mem = mmapForLinker(section->size+stub_space, MEM_READ_WRITE,
MAP_ANON, -1, 0);
-
- if( mem == MAP_FAILED ) {
- sysErrorBelch("failed to mmap allocated memory to load section
%d. "
---
-GitLab
-
-
-From 7bdb5766550257b5346dad65d4f946dac64739ad Mon Sep 17 00:00:00 2001
-From: Ben Gamari <ben(a)smart-cactus.org>
-Date: Sat, 5 Feb 2022 23:12:07 -0500
-Subject: [PATCH 12/13] rts/linker: Catch archives masquerading as object files
-
-Check the file's header to catch static archive bearing the `.o`
-extension, as may happen on Windows after the Clang refactoring.
-
-See #21068
----
- rts/Linker.c | 11 ++++++++++-
- rts/LinkerInternals.h | 4 ++++
- rts/linker/LoadArchive.c | 20 +++++++++++++++++++-
- 3 files changed, 33 insertions(+), 2 deletions(-)
-
-diff --git a/rts/Linker.c b/rts/Linker.c
-index 9754bf9f4f2..19545fd3db5 100644
---- a/rts/Linker.c
-+++ b/rts/Linker.c
-@@ -1394,7 +1394,7 @@ preloadObjectFile (pathchar *path)
-
- image = stgMallocBytes(fileSize, "loadObj(image)");
-
--#endif
-+#endif /* !defined(darwin_HOST_OS) */
-
- int n;
- n = fread ( image, 1, fileSize, f );
-@@ -1439,6 +1439,15 @@ static HsInt loadObj_ (pathchar *path)
- return 1; // success
- }
-
-+ if (isArchive(path)) {
-+ if (loadArchive_(path)) {
-+ return 1; // success
-+ } else {
-+ IF_DEBUG(linker,
-+ debugBelch("tried and failed to load %" PATH_FMT
" as an archive\n", path));
-+ }
-+ }
-+
- ObjectCode *oc = preloadObjectFile(path);
- if (oc == NULL) return 0;
-
-diff --git a/rts/LinkerInternals.h b/rts/LinkerInternals.h
-index ccda39b0cf0..f2c36e057a0 100644
---- a/rts/LinkerInternals.h
-+++ b/rts/LinkerInternals.h
-@@ -407,6 +407,10 @@ pathchar*
- resolveSymbolAddr (pathchar* buffer, int size,
- SymbolAddr* symbol, uintptr_t* top);
-
-+/* defined in LoadArchive.c */
-+bool isArchive (pathchar *path);
-+HsInt loadArchive_ (pathchar *path);
-+
- /*************************************************
- * Various bits of configuration
- *************************************************/
-diff --git a/rts/linker/LoadArchive.c b/rts/linker/LoadArchive.c
-index f9282f197ff..9804db38728 100644
---- a/rts/linker/LoadArchive.c
-+++ b/rts/linker/LoadArchive.c
-@@ -241,7 +241,7 @@ lookupGNUArchiveIndex(int gnuFileIndexSize, char **fileName_,
- return true;
- }
-
--static HsInt loadArchive_ (pathchar *path)
-+HsInt loadArchive_ (pathchar *path)
- {
- char *image = NULL;
- HsInt retcode = 0;
-@@ -631,3 +631,21 @@ HsInt loadArchive (pathchar *path)
- RELEASE_LOCK(&linker_mutex);
- return r;
- }
-+
-+bool isArchive (pathchar *path)
-+{
-+ static const char ARCHIVE_HEADER[] = "!<arch>\n";
-+ char buffer[10];
-+ FILE *f = pathopen(path, WSTR("rb"));
-+ if (f == NULL) {
-+ return false;
-+ }
-+
-+ size_t ret = fread(buffer, 1, sizeof(buffer), f);
-+ if (ret < sizeof(buffer)) {
-+ return false;
-+ }
-+ fclose(f);
-+ return strncmp(ARCHIVE_HEADER, buffer, sizeof(ARCHIVE_HEADER)-1) == 0;
-+}
-+
---
-GitLab
-
-
-From 69c02cbfaf8686ac7811f472aacb87415e29ce1f Mon Sep 17 00:00:00 2001
-From: Ben Gamari <ben(a)smart-cactus.org>
-Date: Mon, 7 Feb 2022 20:15:15 -0500
-Subject: [PATCH 13/13] linker: Don't use MAP_FIXED
-
-As noted in #21057, we really shouldn't be using MAP_FIXED. I would much
-rather have the process crash with a "failed to map" error than randomly
-overwrite existing mappings.
-
-Closes #21057.
-
-(cherry picked from commit 1db4f1fe7603c338ead0ac7e1ecfd0d8354d37bf)
----
- rts/linker/MMap.c | 11 ++++-------
- 1 file changed, 4 insertions(+), 7 deletions(-)
-
-diff --git a/rts/linker/MMap.c b/rts/linker/MMap.c
-index 6226609604e..941dc86452c 100644
---- a/rts/linker/MMap.c
-+++ b/rts/linker/MMap.c
-@@ -177,13 +177,10 @@ mmap_again:
- if ((W_)result > 0x80000000) {
- // oops, we were given memory over 2Gb
- munmap(result,size);
--#if defined(freebsd_HOST_OS) || \
-- defined(kfreebsdgnu_HOST_OS) || \
-- defined(dragonfly_HOST_OS)
-- // Some platforms require MAP_FIXED. This is normally
-- // a bad idea, because MAP_FIXED will overwrite
-- // existing mappings.
-- fixed = MAP_FIXED;
-+#if defined(MAP_TRYFIXED)
-+ // Some platforms require MAP_FIXED. We use MAP_TRYFIXED since
-+ // MAP_FIXED will overwrite existing mappings.
-+ fixed = MAP_TRYFIXED;
- goto mmap_again;
- #else
- reportMemoryMap();
---
-GitLab
-
diff --git a/ghc9.2.spec b/ghc9.2.spec
index 6f39cd3..a6c49ec 100644
--- a/ghc9.2.spec
+++ b/ghc9.2.spec
@@ -67,12 +67,12 @@
%endif
Name: %{ghc_name}
-Version: 9.2.7
+Version: 9.2.8
# Since library subpackages are versioned:
# - release can only be reset if *all* library versions get bumped simultaneously
# (sometimes after a major release)
# - minor release numbers for a branch should be incremented monotonically
-Release: 17%{?dist}
+Release: 18%{?dist}
Summary: Glasgow Haskell Compiler
License: BSD-3-Clause and HaskellReport
@@ -88,8 +88,6 @@ Source7: runghc.man
#
https://bugzilla.redhat.com/show_bug.cgi?id=2142238
ExcludeArch: armv7hl
-#
https://gitlab.haskell.org/ghc/ghc/-/issues/19421 (m32_allocator_init)
-Patch0:
https://gitlab.haskell.org/ghc/ghc/-/merge_requests/10453.patch
# absolute haddock path (was for html/libraries -> libraries)
Patch1: ghc-gen_contents_index-haddock-path.patch
Patch2: ghc-Cabal-install-PATH-warning.patch
@@ -405,7 +403,6 @@ Installing this package causes %{name}-*-prof packages corresponding
to
%prep
%setup -q -n ghc-%{version} %{?with_testsuite:-b1}
-%patch -P0 -p1 -b .orig
%patch -P1 -p1 -b .orig
%patch -P3 -p1 -b .orig
@@ -973,6 +970,10 @@ env -C %{ghc_html_libraries_dir} ./gen_contents_index
%changelog
+* Mon May 29 2023 Jens Petersen <petersen(a)redhat.com> - 9.2.8-18
+- update to 9.2.8
+-
https://downloads.haskell.org/~ghc/9.2.8/docs/html/users_guide/9.2.8-note...
+
* Thu May 25 2023 Jens Petersen <petersen(a)redhat.com> - 9.2.7-17
- include backport of 9.4 m32_allocator_init changes by Sylvain Henry (#2209162)
- SPDX migration of license tags
diff --git a/sources b/sources
index b8d237e..cb51a30 100644
--- a/sources
+++ b/sources
@@ -1 +1 @@
-SHA512 (ghc-9.2.7-src.tar.lz) =
a36c560929a56c3268e5f5d7ba8e0d020db5e2ff99bbc61837b1f629a753af747f92d778d9f507a56d491d4e6ac4d229025c4610db202185fb461a54f00200d8
+SHA512 (ghc-9.2.8-src.tar.lz) =
93a567fd10a5f8bc0e8f3f6af40e0ebc5e4cdd42245cf7c6d28388263632610dea02e9794ae72911ee9b0072c12b921bc84ba9980bed4c25b7adcbe5984368b4