diff --git a/.gitignore b/.gitignore deleted file mode 100644 index 9893035..0000000 --- a/.gitignore +++ /dev/null @@ -1,44 +0,0 @@ -ghc-6.12.3-src.tar.bz2 -testsuite-6.12.3.tar.bz2 -/ghc-7.0.1-src.tar.bz2 -/testsuite-7.0.1.tar.bz2 -/ghc-7.0.2-src.tar.bz2 -/ghc-7.0.4-src.tar.bz2 -/testsuite-7.0.4.tar.bz2 -/ghc-7.4.1-testsuite.tar.bz2 -/ghc-7.4.1-src.tar.bz2 -/ghc-7.4.2-src.tar.bz2 -/ghc-7.4.2-testsuite.tar.bz2 -/ghc-7.6.3-src.tar.bz2 -/ghc-7.6.3-testsuite.tar.bz2 -/ghc-7.6.3/ -/ghc-7.8.3-src.tar.xz -/ghc-7.8.3-testsuite.tar.xz -/ghc-7.8.4-src.tar.xz -/ghc-7.8.4-testsuite.tar.xz -/ghc-7.8.4/ -/ghc-7.10.3/ -/ghc-7.10.3b-src.tar.xz -/ghc-7.10.3b-testsuite.tar.xz -/ghc-8.0.2-testsuite.tar.xz -/ghc-8.0.2-src.tar.xz -/ghc-8.0.2/ -/ghc-8.2.2-src.tar.xz -/ghc-8.2.2-testsuite.tar.xz -/ghc-8.4.4-src.tar.xz -/ghc-8.6.5-src.tar.xz -/ghc-8.8.3-src.tar.xz -/ghc-8.8.3-src.tar.xz.sig -/ghc-8.8.4-src.tar.xz.sig -/ghc-8.8.4-src.tar.xz -/ghc-8.10.5-src.tar.xz.sig -/ghc-8.10.5-src.tar.xz -/ghc-8.10.4-src.tar.xz.sig -/ghc-8.10.7-src.tar.xz -/ghc-8.10.7-src.tar.xz.sig -/ghc-9.0.2-src.tar.xz -/ghc-9.0.2-src.tar.xz.sig -/ghc-9.2.5-src.tar.xz -/ghc-9.2.5-src.tar.xz.sig -/ghc-9.2.6-src.tar.xz -/ghc-9.2.6-src.tar.xz.sig diff --git a/00dc51060881df81258ba3b3bdf447294618a4de.patch b/00dc51060881df81258ba3b3bdf447294618a4de.patch deleted file mode 100644 index 91a37b3..0000000 --- a/00dc51060881df81258ba3b3bdf447294618a4de.patch +++ /dev/null @@ -1,44 +0,0 @@ -From 00dc51060881df81258ba3b3bdf447294618a4de Mon Sep 17 00:00:00 2001 -From: Matthew Pickering -Date: Tue, 3 Jan 2023 15:56:37 +0000 -Subject: [PATCH] sphinx: Use modern syntax for extlinks - -This fixes the following build error: - -``` - Command line: /opt/homebrew/opt/sphinx-doc/bin/sphinx-build -b man -d /private/tmp/extra-dir-55768274273/.doctrees-man -n -w /private/tmp/extra-dir-55768274273/.log docs/users_guide /private/tmp/extra-dir-55768274273 - ===> Command failed with error code: 2 - - Exception occurred: - File "/opt/homebrew/Cellar/sphinx-doc/6.0.0/libexec/lib/python3.11/site-packages/sphinx/ext/extlinks.py", line 101, in role - title = caption % part - ~~~~~~~~^~~~~~ - TypeError: not all arguments converted during string formatting -``` - -I tested on Sphinx-5.1.1 and Sphinx-6.0.0 - -Thanks for sterni for providing instructions about how to test using -sphinx-6.0.0. - -Fixes #22690 ---- - docs/users_guide/ghc_config.py.in | 4 ++-- - 1 file changed, 2 insertions(+), 2 deletions(-) - -diff --git a/docs/users_guide/ghc_config.py.in b/docs/users_guide/ghc_config.py.in -index dcc7fbaef62..c9888a13adc 100644 ---- a/docs/users_guide/ghc_config.py.in -+++ b/docs/users_guide/ghc_config.py.in -@@ -1,6 +1,6 @@ - extlinks = { -- 'ghc-ticket': ('https://gitlab.haskell.org/ghc/ghc/issues/%s', '#'), -- 'ghc-wiki': ('https://gitlab.haskell.org/ghc/ghc/wikis/%s', '#'), -+ 'ghc-ticket': ('https://gitlab.haskell.org/ghc/ghc/issues/%s', '%s'), -+ 'ghc-wiki': ('https://gitlab.haskell.org/ghc/ghc/wikis/%s', '#%s'), - } - - libs_base_uri = '../libraries' --- -GitLab - 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 -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 -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 -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 -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 -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 -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 -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 -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 -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 -+ -+#if defined(darwin_HOST_OS) -+#include -+#include -+#include -+#include -+#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 - #include -@@ -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 -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 -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 - #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 - #include -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 -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 -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 -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 -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 -+#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 -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 -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 - -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 -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 -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[] = "!\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 -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/5725.patch b/5725.patch deleted file mode 100644 index ae4bd8b..0000000 --- a/5725.patch +++ /dev/null @@ -1,35 +0,0 @@ -From 7cfa6f3114168797cf1fa7faa4ffe6c06b73f149 Mon Sep 17 00:00:00 2001 -From: Peter Trommler -Date: Tue, 11 May 2021 20:52:01 +0200 -Subject: [PATCH] Hadrian: Enable SMP on powerpc64{le} - -Fixes #19825 ---- - hadrian/src/Oracles/Flag.hs | 11 ++++++++++- - 1 file changed, 10 insertions(+), 1 deletion(-) - -diff --git a/hadrian/src/Oracles/Flag.hs b/hadrian/src/Oracles/Flag.hs -index 86521e4aa8a..1b3aff693eb 100644 ---- a/hadrian/src/Oracles/Flag.hs -+++ b/hadrian/src/Oracles/Flag.hs -@@ -70,7 +70,16 @@ targetSupportsSMP :: Action Bool - targetSupportsSMP = do - unreg <- flag GhcUnregisterised - armVer <- targetArmVersion -- goodArch <- anyTargetArch ["i386", "x86_64", "sparc", "powerpc", "arm", "aarch64", "s390x", "riscv64"] -+ goodArch <- anyTargetArch ["i386" -+ , "x86_64" -+ , "sparc" -+ , "powerpc" -+ , "powerpc64" -+ , "powerpc64le" -+ , "arm" -+ , "aarch64" -+ , "s390x" -+ , "riscv64"] - if -- The THREADED_RTS requires `BaseReg` to be in a register and the - -- Unregisterised mode doesn't allow that. - | unreg -> return False --- -GitLab - diff --git a/9394.patch b/9394.patch deleted file mode 100644 index 9880de4..0000000 --- a/9394.patch +++ /dev/null @@ -1,43 +0,0 @@ -From 480b5d6440bbbd0b89dabdb2dc957333056aa2a7 Mon Sep 17 00:00:00 2001 -From: Florian Weimer -Date: Tue, 22 Nov 2022 15:23:50 +0100 -Subject: [PATCH] m4/fp_leading_underscore.m4: Avoid implicit exit function - declaration - -And switch to a new-style function definition. - -Fixes build issues with compilers that do not accept implicit function -declarations. ---- - m4/fp_leading_underscore.m4 | 10 ++++------ - 1 file changed, 4 insertions(+), 6 deletions(-) - -diff --git a/m4/fp_leading_underscore.m4 b/m4/fp_leading_underscore.m4 -index fde57c7625d..939cee3b69f 100644 ---- a/m4/fp_leading_underscore.m4 -+++ b/m4/fp_leading_underscore.m4 -@@ -32,17 +32,15 @@ struct nlist xYzzY1[] = {{"xYzzY1", 0},{0}}; - struct nlist xYzzY2[] = {{"_xYzzY2", 0},{0}}; - #endif - --int main(argc, argv) --int argc; --char **argv; -+int main(int argc, char **argv) - { - #if defined(HAVE_NLIST_H) - if(nlist(argv[0], xYzzY1) == 0 && xYzzY1[0].n_value != 0) -- exit(1); -+ return 1; - if(nlist(argv[0], xYzzY2) == 0 && xYzzY2[0].n_value != 0) -- exit(0); -+ return 0; - #endif -- exit(1); -+ return 1; - }]])],[fptools_cv_leading_underscore=yes],[fptools_cv_leading_underscore=no],[fptools_cv_leading_underscore=no]) - ;; - esac]); --- -GitLab - diff --git a/9aace0eaf6279f17368a1753b65afbdc466e8291.patch b/9aace0eaf6279f17368a1753b65afbdc466e8291.patch deleted file mode 100644 index 5e33f76..0000000 --- a/9aace0eaf6279f17368a1753b65afbdc466e8291.patch +++ /dev/null @@ -1,93 +0,0 @@ -From 9aace0eaf6279f17368a1753b65afbdc466e8291 Mon Sep 17 00:00:00 2001 -From: Sylvain Henry -Date: Sat, 10 Apr 2021 14:48:16 +0200 -Subject: [PATCH] Produce constant file atomically (#19684) - ---- - utils/deriveConstants/Main.hs | 21 ++++++++++++++++----- - utils/deriveConstants/deriveConstants.cabal | 3 ++- - 2 files changed, 18 insertions(+), 6 deletions(-) - -diff --git a/utils/deriveConstants/Main.hs b/utils/deriveConstants/Main.hs -index 8bf8ae7b44d..9db673a9852 100644 ---- a/utils/deriveConstants/Main.hs -+++ b/utils/deriveConstants/Main.hs -@@ -34,9 +34,10 @@ import Data.Maybe (catMaybes, mapMaybe, fromMaybe) - import Numeric (readHex) - import System.Environment (getArgs) - import System.Exit (ExitCode(ExitSuccess), exitFailure) --import System.FilePath (()) -+import System.FilePath ((),(<.>)) - import System.IO (stderr, hPutStrLn) - import System.Process (showCommandForUser, readProcess, rawSystem) -+import System.Directory (renameFile) - - main :: IO () - main = do opts <- parseArgs -@@ -79,6 +80,16 @@ data Options = Options { - o_targetOS :: Maybe String - } - -+-- | Write a file atomically -+-- -+-- This avoids other processes seeing the file while it is being written into. -+atomicWriteFile :: FilePath -> String -> IO () -+atomicWriteFile fn s = do -+ let tmp = fn <.> "tmp" -+ writeFile tmp s -+ renameFile tmp fn -+ -+ - parseArgs :: IO Options - parseArgs = do args <- getArgs - opts <- f emptyOptions args -@@ -670,7 +681,7 @@ getWanted verbose os tmpdir gccProgram gccFlags nmProgram mobjdumpProgram - = do let cStuff = unlines (headers ++ concatMap (doWanted . snd) (wanteds os)) - cFile = tmpdir "tmp.c" - oFile = tmpdir "tmp.o" -- writeFile cFile cStuff -+ atomicWriteFile cFile cStuff - execute verbose gccProgram (gccFlags ++ ["-c", cFile, "-o", oFile]) - xs <- case os of - "openbsd" -> readProcess objdumpProgam ["--syms", oFile] "" -@@ -855,7 +866,7 @@ getWanted verbose os tmpdir gccProgram gccFlags nmProgram mobjdumpProgram - = return (w, FieldTypeGcptrMacro name) - - writeHaskellType :: FilePath -> [What Fst] -> IO () --writeHaskellType fn ws = writeFile fn xs -+writeHaskellType fn ws = atomicWriteFile fn xs - where xs = unlines [header, body, footer, parser] - header = "module GHC.Platform.Constants where\n\n\ - \import Prelude\n\ -@@ -920,7 +931,7 @@ writeHaskellType fn ws = writeFile fn xs - - - writeHaskellValue :: FilePath -> [What Snd] -> IO () --writeHaskellValue fn rs = writeFile fn xs -+writeHaskellValue fn rs = atomicWriteFile fn xs - where xs = unlines [header, body, footer] - header = "PlatformConstants {" - footer = " }" -@@ -937,7 +948,7 @@ writeHaskellValue fn rs = writeFile fn xs - doWhat (FieldTypeGcptrMacro {}) = [] - - writeHeader :: FilePath -> [(Where, What Snd)] -> IO () --writeHeader fn rs = writeFile fn xs -+writeHeader fn rs = atomicWriteFile fn xs - where xs = headers ++ hs ++ unlines body - headers = "/* This file is created automatically. Do not edit by hand.*/\n\n" - haskellRs = fmap snd $ filter (\r -> fst r `elem` [Haskell,Both]) rs -diff --git a/utils/deriveConstants/deriveConstants.cabal b/utils/deriveConstants/deriveConstants.cabal -index 50b5b695c30..36ba7ebe1f7 100644 ---- a/utils/deriveConstants/deriveConstants.cabal -+++ b/utils/deriveConstants/deriveConstants.cabal -@@ -20,4 +20,5 @@ Executable deriveConstants - Build-Depends: base >= 4 && < 5, - containers, - process, -- filepath -+ filepath, -+ directory --- -GitLab - diff --git a/Disable-unboxed-arrays.patch b/Disable-unboxed-arrays.patch deleted file mode 100644 index 4ccb16d..0000000 --- a/Disable-unboxed-arrays.patch +++ /dev/null @@ -1,10 +0,0 @@ ---- ghc-8.8.0.20190721/libraries/containers/containers/include/containers.h~ 2019-06-26 20:39:26.000000000 +0000 -+++ ghc-8.8.0.20190721/libraries/containers/containers/include/containers.h 2019-07-27 08:55:10.747060247 +0000 -@@ -35,7 +35,6 @@ - - #ifdef __GLASGOW_HASKELL__ - # define USE_ST_MONAD 1 --# define USE_UNBOXED_ARRAYS 1 - #endif - - #endif diff --git a/abi-check.sh b/abi-check.sh deleted file mode 100755 index fc428f0..0000000 --- a/abi-check.sh +++ /dev/null @@ -1,48 +0,0 @@ -#!/bin/sh - -[ $# -ne 2 ] && echo "Usage: $(basename $0) ver-rel1 ver-rel2" && exit 1 - -if [ "$1" = "$2" ]; then - echo "ver-rel's must be different!" - exit 1 -fi - -#set -x - -mkdir -p koji -cd koji - -for i in $1 $2; do - if [ ! -d "$i" ]; then - mkdir -p $i/{x86_64,i686,armv7hl} - cd $i - for a in x86_64 i686 armv7hl; do - cd $a - koji download-build --arch=$a ghc-$i - cd .. - done - cd .. - fi -done - -for a in x86_64 i686 armv7hl; do - echo "= $a =" - for i in $1/$a/*; do - PKGVER=$(rpm -qp --qf "%{name}-%{version}" $i) - PKG2=$(ls $2/$a/$PKGVER*.$a.rpm) - PROV1=$(rpm -qp --provides $i | grep ^ghc\( | grep -v =) - PROV2=$(rpm -qp --provides $PKG2 | grep ^ghc\( | grep -v =) -# if [ -n "$PROV1" ]; then -# echo $PROV1 -# else -# echo "no provides for $i" -# fi - if [ -n "$PROV2" ]; then - if [ "$PROV1" != "$PROV2" ]; then - echo $PROV2 - fi -# else -# echo "no provides for $PKG2" - fi - done -done diff --git a/buildpath-abi-stability-2.patch b/buildpath-abi-stability-2.patch deleted file mode 100644 index a2e8fa7..0000000 --- a/buildpath-abi-stability-2.patch +++ /dev/null @@ -1,87 +0,0 @@ -Description: Don't include BufPos in interface files -Author: Matthew Pickering -Origin: https://gitlab.haskell.org/ghc/ghc/-/merge_requests/8972 -Bug: https://gitlab.haskell.org/ghc/ghc/-/issues/22162 -Index: b/compiler/GHC/Iface/Ext/Types.hs -=================================================================== ---- a/compiler/GHC/Iface/Ext/Types.hs -+++ b/compiler/GHC/Iface/Ext/Types.hs -@@ -746,5 +746,5 @@ toHieName name - | isKnownKeyName name = KnownKeyName (nameUnique name) - | isExternalName name = ExternalName (nameModule name) - (nameOccName name) -- (nameSrcSpan name) -- | otherwise = LocalName (nameOccName name) (nameSrcSpan name) -+ (removeBufSpan $ nameSrcSpan name) -+ | otherwise = LocalName (nameOccName name) (removeBufSpan $ nameSrcSpan name) -Index: b/compiler/GHC/Types/SrcLoc.hs -=================================================================== ---- a/compiler/GHC/Types/SrcLoc.hs -+++ b/compiler/GHC/Types/SrcLoc.hs -@@ -72,6 +72,7 @@ module GHC.Types.SrcLoc ( - getBufPos, - BufSpan(..), - getBufSpan, -+ removeBufSpan, - - -- * Located - Located, -@@ -397,6 +398,10 @@ data UnhelpfulSpanReason - | UnhelpfulOther !FastString - deriving (Eq, Show) - -+removeBufSpan :: SrcSpan -> SrcSpan -+removeBufSpan (RealSrcSpan s _) = RealSrcSpan s Nothing -+removeBufSpan s = s -+ - {- Note [Why Maybe BufPos] - ~~~~~~~~~~~~~~~~~~~~~~~~~~ - In SrcLoc we store (Maybe BufPos); in SrcSpan we store (Maybe BufSpan). -Index: b/compiler/GHC/Utils/Binary.hs -=================================================================== ---- a/compiler/GHC/Utils/Binary.hs -+++ b/compiler/GHC/Utils/Binary.hs -@@ -1444,19 +1444,6 @@ instance Binary RealSrcSpan where - return (mkRealSrcSpan (mkRealSrcLoc f sl sc) - (mkRealSrcLoc f el ec)) - --instance Binary BufPos where -- put_ bh (BufPos i) = put_ bh i -- get bh = BufPos <$> get bh -- --instance Binary BufSpan where -- put_ bh (BufSpan start end) = do -- put_ bh start -- put_ bh end -- get bh = do -- start <- get bh -- end <- get bh -- return (BufSpan start end) -- - instance Binary UnhelpfulSpanReason where - put_ bh r = case r of - UnhelpfulNoLocationInfo -> putByte bh 0 -@@ -1475,10 +1462,11 @@ instance Binary UnhelpfulSpanReason wher - _ -> UnhelpfulOther <$> get bh - - instance Binary SrcSpan where -- put_ bh (RealSrcSpan ss sb) = do -+ put_ bh (RealSrcSpan ss _sb) = do - putByte bh 0 -+ -- BufSpan doesn't ever get serialised because the positions depend -+ -- on build location. - put_ bh ss -- put_ bh sb - - put_ bh (UnhelpfulSpan s) = do - putByte bh 1 -@@ -1488,8 +1476,7 @@ instance Binary SrcSpan where - h <- getByte bh - case h of - 0 -> do ss <- get bh -- sb <- get bh -- return (RealSrcSpan ss sb) -+ return (RealSrcSpan ss Nothing) - _ -> do s <- get bh - return (UnhelpfulSpan s) - diff --git a/buildpath-abi-stability.patch b/buildpath-abi-stability.patch deleted file mode 100644 index 07305e9..0000000 --- a/buildpath-abi-stability.patch +++ /dev/null @@ -1,24 +0,0 @@ -Forwarded to https://ghc.haskell.org/trac/ghc/ticket/10424 - -Index: b/compiler/GHC/Iface/Recomp.hs -=================================================================== ---- a/compiler/GHC/Iface/Recomp.hs -+++ b/compiler/GHC/Iface/Recomp.hs -@@ -1071,7 +1071,7 @@ addFingerprints hsc_env iface0 - iface_hash <- computeFingerprint putNameLiterally - (mod_hash, - ann_fn (mkVarOcc "module"), -- See mkIfaceAnnCache -- mi_usages iface0, -+ usages, - sorted_deps, - mi_hpc iface0) - -@@ -1106,6 +1106,8 @@ addFingerprints hsc_env iface0 - (non_orph_rules, orph_rules) = mkOrphMap ifRuleOrph (mi_rules iface0) - (non_orph_fis, orph_fis) = mkOrphMap ifFamInstOrph (mi_fam_insts iface0) - ann_fn = mkIfaceAnnCache (mi_anns iface0) -+ -- Do not allow filenames to affect the interface -+ usages = [ case u of UsageFile _ fp -> UsageFile "" fp; _ -> u | u <- mi_usages iface0 ] - - -- | Retrieve the orphan hashes 'mi_orphan_hash' for a list of modules - -- (in particular, the orphan modules which are transitively imported by the diff --git a/dead.package b/dead.package new file mode 100644 index 0000000..558af87 --- /dev/null +++ b/dead.package @@ -0,0 +1 @@ +ghc package is retired on branch c10s for BAKERY-412 \ No newline at end of file diff --git a/ghc-9.2.1-hadrian-s390x-rts--qg.patch b/ghc-9.2.1-hadrian-s390x-rts--qg.patch deleted file mode 100644 index ebdb8e3..0000000 --- a/ghc-9.2.1-hadrian-s390x-rts--qg.patch +++ /dev/null @@ -1,9 +0,0 @@ ---- ghc-9.2.1/hadrian/hadrian.cabal~ 2021-10-29 04:41:34.000000000 +0800 -+++ ghc-9.2.1/hadrian/hadrian.cabal 2021-11-01 15:02:49.625656704 +0800 -@@ -162,5 +162,5 @@ - -- waiting for external processes - -- * -qg: Don't use parallel GC as the synchronization - -- time tends to eat any benefit. -- "-with-rtsopts=-I0 -qg" -+ "-with-rtsopts=-I0" - -threaded diff --git a/ghc-Cabal-install-PATH-warning.patch b/ghc-Cabal-install-PATH-warning.patch deleted file mode 100644 index 5f2baa7..0000000 --- a/ghc-Cabal-install-PATH-warning.patch +++ /dev/null @@ -1,12 +0,0 @@ ---- ghc/libraries/Cabal/Cabal/src/Distribution/Simple/Install.hs~ 2017-05-05 23:51:43.000000000 +0900 -+++ ghc/libraries/Cabal/Cabal/src/Distribution/Simple/Install.hs 2018-02-27 12:22:13.159432104 +0900 -@@ -215,8 +215,7 @@ - ++ " in " ++ binPref) - inPath <- isInSearchPath binPref - when (not inPath) $ -- warn verbosity ("The directory " ++ binPref -- ++ " is not in the system search path.") -+ warn verbosity ("Executable installed in " ++ binPref) - case compilerFlavor (compiler lbi) of - GHC -> GHC.installExe verbosity lbi binPref buildPref progFix pkg_descr exe - GHCJS -> GHCJS.installExe verbosity lbi binPref buildPref progFix pkg_descr exe diff --git a/ghc-armv7-VFPv3D16--NEON.patch b/ghc-armv7-VFPv3D16--NEON.patch deleted file mode 100644 index e51a353..0000000 --- a/ghc-armv7-VFPv3D16--NEON.patch +++ /dev/null @@ -1,11 +0,0 @@ ---- ghc-7.8.3/aclocal.m4~ 2014-07-10 13:27:16.000000000 +0900 -+++ ghc-7.8.3/aclocal.m4 2014-11-05 12:19:08.530044128 +0900 -@@ -408,7 +408,7 @@ - )], - [changequote(, )dnl - ARM_ISA=ARMv7 -- ARM_ISA_EXT="[VFPv3,NEON]" -+ ARM_ISA_EXT="[VFPv3D16]" - changequote([, ])dnl - ]) - ]) diff --git a/ghc-gen_contents_index-haddock-path.patch b/ghc-gen_contents_index-haddock-path.patch deleted file mode 100644 index e6819ee..0000000 --- a/ghc-gen_contents_index-haddock-path.patch +++ /dev/null @@ -1,10 +0,0 @@ ---- ghc-7.6.3/libraries/gen_contents_index~ 2013-04-19 06:22:46.000000000 +0900 -+++ ghc-7.6.3/libraries/gen_contents_index 2013-04-22 12:07:48.922152864 +0900 -@@ -60,6 +60,6 @@ - done - else -- HADDOCK=../../../../../bin/haddock -+ HADDOCK=/usr/bin/haddock - # We don't want the GHC API to swamp the index - HADDOCK_FILES=`ls -1 */*.haddock | grep -v '/ghc\.haddock' | sort` - HADDOCK_ARGS="-p prologue.txt" diff --git a/ghc-gen_contents_index-nodocs.patch b/ghc-gen_contents_index-nodocs.patch deleted file mode 100644 index bb7f9a6..0000000 --- a/ghc-gen_contents_index-nodocs.patch +++ /dev/null @@ -1,11 +0,0 @@ ---- ghc-8.6.5/libraries/gen_contents_index~ 2020-02-24 15:02:26.318866694 +0800 -+++ ghc-8.6.5/libraries/gen_contents_index 2020-04-09 18:18:40.290722327 +0800 -@@ -47,6 +47,8 @@ - HADDOCK_ARGS="$HADDOCK_ARGS $HADDOCK_ARG" - done - else -+ if ! ls */*.haddock &>/dev/null; then exit 0; fi -+ - HADDOCK=/usr/bin/haddock - # We don't want the GHC API to swamp the index - HADDOCK_FILES=`ls -1 */*.haddock | grep -v '/ghc\.haddock' | sort` diff --git a/ghc-pkg.man b/ghc-pkg.man deleted file mode 100644 index ccac8e4..0000000 --- a/ghc-pkg.man +++ /dev/null @@ -1,228 +0,0 @@ -.TH ghc-pkg 1 "2010-01-27" -.SH NAME -ghc-pkg \- GHC Haskell Cabal package manager -.SH SYNOPSIS -.B ghc-pkg -.I action -.RI [ OPTION ]... -.SH DESCRIPTION -A package is a library of Haskell modules known to the compiler. The -.B ghc-pkg -tool allows adding or removing them from a package database. By -default, the system-wide package database is modified, but -alternatively the user's local package database or another specified -file can be used. -.PP -To make a package available for -.BR ghc , -.B ghc-pkg -can be used to register it. Unregistering it removes it from the -database. Also, packages can be hidden, to make -.B ghc -ignore the package by default, without uninstalling it. Exposing a -package makes a hidden package available. Additionally, -.B ghc-pkg -has various commands to query the package database. -.PP -Where a package name is required, the package can be named in full -including the version number (e.g. -.BR network-1.0 ), -or without the version number. Naming a package without the version -number matches all versions of the package; the specified action will -be applied to all the matching packages. A package specifier that -matches all version of the package can also be written -.BR pkg-* , -to make it clearer that multiple packages are being matched. -.SH ACTIONS -.TP -\fBregister\fP \fIfilename\fP|\fB-\fP -Register the package using the specified installed package -description. -.TP -\fBupdate\fP \fIfilename\fP|\fB-\fP -Register the package, overwriting any other package with the same -name. -.TP -\fBunregister\fP \fIpkg-id\fP -Unregister the specified package. -.TP -\fBexpose\fP \fIpkg-id\fP -Expose the specified package. -.TP -\fBhide\fP \fIpkg-id\fP -Hide the specified package -.TP -\fBlist\fP \fR[\fIpkg\fR]...\fP -List registered packages in the global database, and also the user -database if -.B --user -is given. If a package name is given all the registered versions will -be listed in ascending order. Accepts the -.B --simple-output -flag. -.TP -.B dot -Generate a graph of the package dependencies in a form suitable for -input for the graphviz tools. For example, to generate a PDF of the -dependency graph: -.br -\fB dot \| tred \| dot -Tpdf >pkgs.pdf\fP -.TP -\fBfind-module\fP \fImodule\fP -List registered packages exposing module -.I module -in the global database, and also the user database if -.B --user -is given. All the registered versions will be listed in ascending -order. Accepts the -.B --simple-output -flag. -.TP -\fBlatest\fP \fIpkg-id\fP -Prints the highest registered version of a package. -.TP -.B check -Check the consistency of package dependencies and list broken -packages. Accepts the -.B --simple-output -flag. -.TP -\fBdescribe\fP \fIpkg\fP -Give the registered description for the -specified package. The description is returned in precisely the syntax -required by ghc-pkg register. -.TP -\fBfield\fP \fIpkg field\fP -Extract the specified field of the package description for the -specified package. Accepts comma-separated multiple fields. -.TP -.B dump -Dump the registered description for every package. This is like -.BR ghc-pkg\ describe\ '*' , -expect that it is intended to be used by tools that parse the results, -rather than humans. -.TP -.B recache -Regenerate the package database cache. This command should only be -necessary if you added a package to the database by dropping a file -into the database directory manyally. By default, the global DB is -recached; to recache a different DB use -.B --user -or -.B --package-conf -as appropriate. -.SH OPTIONS -When asked to modify a database -.RB ( register ,\ unregister ,\ update ,\ hide ,\ expose ,\ and\ also\ check ), -.B ghc-pkg -modifies the global database by -default. Specifying -.B --user -causes it to act on the user database, -or -.B --package-conf -can be used to act on another database -entirely. When multiple of these options are given, the rightmost -one is used as the database to act upon. -.PP -Commands that query the package database -.RB ( list ,\ latest ,\ describe ,\ field ) -operate on the list of databases specified by the flags -.BR --user ,\ --global , -and -.BR --package-conf . -If none of these flags are -given, the default is -.BR --global\ --user . -.TP -.B --user -Use the current user's package database. -.TP -.B --global -Use the global package database. -.TP -\fB-f\fP \fIFILE\fP, \fB--package-conf=\fIFILE\fP -Use the specified package config file. -.TP -.BI --global-conf= FILE -Location of the global package config. -.TP -.B --force -Ignore missing dependencies, directories, and libraries. -.TP -.B --force-files -Ignore missing directories and libraries only. -.TP -.BR -g ,\ --auto-ghc-libs -Automatically build libs for GHCi (with register). -.TP -.BR -? ,\ --help -Display a help message and exit. -.TP -.BR -V ,\ --version -Output version information and exit. -.TP -.B --simple-output -Print output in easy-to-parse format for some commands. -.TP -.B --names-only -Only print package names, not versions; can only be used with -.BR list\ --simple-output . -.TP -.B --ignore-case -Ignore case for substring matching. -.SH ENVIRONMENT VARIABLES -.TP -.B GHC_PACKAGE_PATH -The -.B GHC_PACKAGE_PATH -environment variable may be set to a -.BR : -separated -list of files containing package databases. This list of package -databases is used by -.B ghc -and -.BR ghc-pkg , -with earlier databases in the list overriding later ones. This order -was chosen to match the behaviour of the -.B PATH -environment variable; think of it as a list of package databases that -are searched left-to-right for packages. - -If -.B GHC_PACKAGE_PATH -ends in a separator, then the default user and system package -databases are appended, in that order. e.g. to augment the usual set -of packages with a database of your own, you could say: - -.br -\fB export GHC_PACKAGE_PATH=$HOME/.my-ghc-packages.conf:\fP -.br - -To check whether your -.B GHC_PACKAGE_PATH -setting is doing the right thing, -.B ghc-pkg list -will list all the databases in use, in the reverse order they are -searched. -.SH FILES -Both of these locations are changed for Debian. Upstream still keeps -these under -.IR /usr . -Some programs may refer to that, but look in -.I /var -instead. -.TP -.I /var/lib/ghc/package.conf -Global package.conf file. -.TP -.I /var/lib/ghc/package.conf.d/ -Directory for library specific package.conf files. These are added to -the global registry. -.SH "SEE ALSO" -.BR ghc (1), -.BR runghc (1), -.BR hugs (1). -.SH AUTHOR -This manual page was written by Kari Pahula , for the -Debian project (and may be used by others). diff --git a/ghc-warnings.mk-CC-Wall.patch b/ghc-warnings.mk-CC-Wall.patch deleted file mode 100644 index f775eb3..0000000 --- a/ghc-warnings.mk-CC-Wall.patch +++ /dev/null @@ -1,12 +0,0 @@ ---- ghc-8.4.3/mk/warnings.mk~ 2018-02-04 02:30:11.000000000 +0900 -+++ ghc-8.4.3/mk/warnings.mk 2018-09-29 14:33:37.607884921 +0900 -@@ -1,6 +1,6 @@ - # See Note [Order of warning flags]. --SRC_CC_OPTS += -Wall $(WERROR) -+#SRC_CC_OPTS += -Wall $(WERROR) - SRC_HC_OPTS += -Wall - # Don't add -Werror to SRC_HC_OPTS_STAGE0 (or SRC_HC_OPTS), because otherwise - # validate may unnecessarily fail when booting with an older compiler. - # It would be better to only exclude certain warnings from becoming errors - -Diff finished. Sat Sep 29 14:35:43 2018 diff --git a/ghc.spec b/ghc.spec deleted file mode 100644 index 28492c7..0000000 --- a/ghc.spec +++ /dev/null @@ -1,2239 +0,0 @@ -# turn off for quick build to disable prof, docs -# This must be enabled 1 for all koji production builds -%bcond prodbuild 1 - -# make sure ghc libraries' ABI hashes unchanged -%bcond abicheck 1 - -# use Hadrian buildsystem for production builds -%bcond hadrian 1 - -# build hadrian for production builds: -%bcond build_hadrian 1 - -# disabled to allow parallel install of ghc9.2-9.2.7 and ghc-9.2.6 -%if 0 -%global ghc_major 9.2 -%global ghc_obsoletes_name ghc%{ghc_major} -%endif - -# to handle RCs -%global ghc_release %{version} - -%global base_ver 4.16.4.0 -%global ghc_bignum_ver 1.2 -%global ghc_compact_ver 0.1.0.0 -%global hpc_ver 0.6.1.0 -%global rts_ver 1.0.2 -%global xhtml_ver 3000.2.2.1 - -%undefine with_ghc_prof -%undefine with_haddock - -# build profiling libraries and haddock documentation -# perf production build (disable for quick build) -%if %{with prodbuild} -%bcond ghc_prof 1 -# https://gitlab.haskell.org/ghc/ghc/-/issues/19754 -# https://github.com/haskell/haddock/issues/1384 -%ifnarch armv7hl %{ix86} -%bcond haddock 1 -%endif -%if %{with hadrian} -%bcond manual 1 -%endif -%bcond perf_build 1 -%else -# Quick build -%bcond ghc_prof 0 -%bcond haddock 0 -%if %{with hadrian} -%bcond manual 0 -%endif -%bcond perf_build 0 -%endif - -%if %{without hadrian} -# to enable dwarf info (only on intel archs): overrides perf -# disabled 0 by default -# Not setup yet for hadrian -%ifarch x86_64 i686 -%bcond dwarf 0 -%endif - -# locked together since disabling haddock causes no manuals built -# and disabling haddock still created index.html -# https://gitlab.haskell.org/ghc/ghc/-/issues/15190 -%{?with_haddock:%bcond manual 1} -%endif - -# no longer build testsuite (takes time and not really being used) -%bcond testsuite 0 - -# 9.2 needs llvm 9-12 -%global llvm_major 12 -%if %{with hadrian} -%global ghc_llvm_archs armv7hl s390x -%global ghc_unregisterized_arches s390 %{mips} riscv64 -%else -%global ghc_llvm_archs armv7hl -%global ghc_unregisterized_arches s390 s390x %{mips} riscv64 -%endif - -%global obsoletes_ghcXY() \ -%if %{defined ghc_obsoletes_name}\ -Obsoletes: %{ghc_obsoletes_name}%{?1:-%1} < %{version}-%{release}\ -Provides: %{ghc_obsoletes_name}%{?1:-%1} = %{version}-%{release}\ -%endif\ -%{nil} - -Name: ghc -Version: 9.2.6 -# 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: 131%{?dist} -Summary: Glasgow Haskell Compiler - -License: BSD-3-clause and HaskellReport -URL: https://haskell.org/ghc/ -Source0: https://downloads.haskell.org/ghc/%{ghc_release}/ghc-%{version}-src.tar.xz -%if %{with testsuite} -Source1: https://downloads.haskell.org/ghc/%{ghc_release}/ghc-%{version}-testsuite.tar.xz -%endif -Source2: https://downloads.haskell.org/ghc/%{ghc_release}/ghc-%{version}-src.tar.xz.sig -Source5: ghc-pkg.man -Source6: haddock.man -Source7: runghc.man - -# cannot until i686 is disabled for koji noarch builds at least (pandoc etc) -#ExcludeArch: %%{ix86} - -# 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 -Patch3: ghc-gen_contents_index-nodocs.patch -# https://gitlab.haskell.org/ghc/ghc/-/issues/23286 (sphinx modern extlinks) -Patch9: https://gitlab.haskell.org/ghc/ghc/-/commit/00dc51060881df81258ba3b3bdf447294618a4de.patch - -# https://phabricator.haskell.org/rGHC4eebc8016f68719e1ccdf460754a97d1f4d6ef05 -# https://gitlab.haskell.org/ghc/ghc/-/issues/19684 -# DerivedConstants.h not produced atomically -Patch10: https://gitlab.haskell.org/ghc/ghc/-/commit/9aace0eaf6279f17368a1753b65afbdc466e8291.patch - -# https://fedoraproject.org/wiki/Toolchain/PortingToModernC -# https://gitlab.haskell.org/ghc/ghc/-/merge_requests/9394 -Patch11: https://gitlab.haskell.org/ghc/ghc/-/merge_requests/9394.patch - -# armv7hl patches -Patch12: ghc-armv7-VFPv3D16--NEON.patch - -# for unregisterized -# https://gitlab.haskell.org/ghc/ghc/-/issues/15689 -Patch15: ghc-warnings.mk-CC-Wall.patch -Patch16: ghc-9.2.1-hadrian-s390x-rts--qg.patch - -# bigendian (s390x and ppc64) -# https://gitlab.haskell.org/ghc/ghc/issues/15411 -# https://gitlab.haskell.org/ghc/ghc/issues/16505 -# https://bugzilla.redhat.com/show_bug.cgi?id=1651448 -# https://gitlab.haskell.org/ghc/ghc/-/issues/15914 -# https://gitlab.haskell.org/ghc/ghc/issues/16973 -# https://bugzilla.redhat.com/show_bug.cgi?id=1733030 -# https://gitlab.haskell.org/ghc/ghc/-/issues/16998 -Patch18: Disable-unboxed-arrays.patch - -# ppc64le -# enable smp with hadrian -# https://gitlab.haskell.org/ghc/ghc/-/issues/19825 -Patch20: https://gitlab.haskell.org/ghc/ghc/-/merge_requests/5725.patch - -# Debian patches: -Patch24: buildpath-abi-stability.patch -Patch26: no-missing-haddock-file-warning.patch -Patch27: haddock-remove-googleapis-fonts.patch - -# fedora ghc has been bootstrapped on -# %%{ix86} x86_64 s390x ppc64le aarch64 -# and retired arches: alpha sparcv9 armv5tel ppc ppc64 s390 armv7hl -# see also deprecated ghc_arches defined in ghc-srpm-macros -# /usr/lib/rpm/macros.d/macros.ghc-srpm - -BuildRequires: ghc-compiler > 8.10 -# for ABI hash checking -%if %{with abicheck} -BuildRequires: %{name} -%endif -BuildRequires: ghc-rpm-macros-extra >= 2.5.0 -BuildRequires: ghc-binary-devel -BuildRequires: ghc-bytestring-devel -BuildRequires: ghc-containers-devel -BuildRequires: ghc-directory-devel -BuildRequires: ghc-pretty-devel -BuildRequires: ghc-process-devel -BuildRequires: ghc-stm-devel -BuildRequires: ghc-template-haskell-devel -BuildRequires: ghc-transformers-devel -BuildRequires: alex -BuildRequires: gmp-devel -BuildRequires: libffi-devel -BuildRequires: make -BuildRequires: gcc-c++ -# for terminfo -BuildRequires: ncurses-devel -BuildRequires: perl-interpreter -# needed for: -# - binary-dist-dir -# - patch11 and patch12 -BuildRequires: autoconf automake -%if %{with testsuite} -BuildRequires: python3 -%endif -%if %{with manual} -BuildRequires: python3-sphinx -%endif -%ifarch %{ghc_llvm_archs} -BuildRequires: llvm%{llvm_major} -%endif -%if %{with dwarf} -BuildRequires: elfutils-devel -%endif -%if %{with prodbuild} -#BuildRequires: gnupg2 -%endif -%if %{with hadrian} -BuildRequires: happy -%if %{with build_hadrian} -BuildRequires: ghc-Cabal-static -BuildRequires: ghc-QuickCheck-static -BuildRequires: ghc-base-static -BuildRequires: ghc-bytestring-static -BuildRequires: ghc-containers-static -BuildRequires: ghc-directory-static -BuildRequires: ghc-extra-static -BuildRequires: ghc-filepath-static -BuildRequires: ghc-mtl-static -BuildRequires: ghc-parsec-static -BuildRequires: ghc-shake-static -BuildRequires: ghc-stm-static -BuildRequires: ghc-transformers-static -BuildRequires: ghc-unordered-containers-static -BuildRequires: alex -%else -BuildRequires: %{name}-hadrian -%endif -%endif -Requires: %{name}-compiler = %{version}-%{release} -Requires: %{name}-devel = %{version}-%{release} -Requires: %{name}-ghc-devel = %{version}-%{release} -Requires: %{name}-ghc-boot-devel = %{version}-%{release} -Requires: %{name}-ghc-compact-devel = %{ghc_compact_ver}-%{release} -Requires: %{name}-ghc-heap-devel = %{version}-%{release} -Requires: %{name}-ghci-devel = %{version}-%{release} -Requires: %{name}-hpc-devel = %{hpc_ver}-%{release} -Requires: %{name}-libiserv-devel = %{version}-%{release} -%if %{with haddock} -Suggests: %{name}-doc = %{version}-%{release} -Suggests: %{name}-doc-index = %{version}-%{release} -%endif -%if %{with manual} -Suggests: %{name}-manual = %{version}-%{release} -%endif -%if %{with ghc_prof} -Suggests: %{name}-prof = %{version}-%{release} -%endif -%obsoletes_ghcXY - -%description -GHC is a state-of-the-art, open source, compiler and interactive environment -for the functional language Haskell. Highlights: - -- GHC supports the entire Haskell 2010 language plus a wide variety of - extensions. -- GHC has particularly good support for concurrency and parallelism, - including support for Software Transactional Memory (STM). -- GHC generates fast code, particularly for concurrent programs. - Take a look at GHC's performance on The Computer Language Benchmarks Game. -- GHC works on several platforms including Windows, Mac, Linux, - most varieties of Unix, and several different processor architectures. -- GHC has extensive optimisation capabilities, including inter-module - optimisation. -- GHC compiles Haskell code either directly to native code or using LLVM - as a back-end. GHC can also generate C code as an intermediate target for - porting to new platforms. The interactive environment compiles Haskell to - bytecode, and supports execution of mixed bytecode/compiled programs. -- Profiling is supported, both by time/allocation and various kinds of heap - profiling. -- GHC comes with several libraries, and thousands more are available on Hackage. - - -%package compiler -Summary: GHC compiler and utilities -License: BSD-3-clause -Requires: gcc%{?_isa} -Requires: %{name}-base-devel%{?_isa} = %{base_ver}-%{release} -%if %{with haddock} -Requires: %{name}-filesystem = %{version}-%{release} -%else -Obsoletes: %{name}-doc-index < %{version}-%{release} -Obsoletes: %{name}-filesystem < %{version}-%{release} -Obsoletes: %{name}-xhtml < %{xhtml_ver}-%{release} -Obsoletes: %{name}-xhtml-devel < %{xhtml_ver}-%{release} -Obsoletes: %{name}-xhtml-doc < %{xhtml_ver}-%{release} -Obsoletes: %{name}-xhtml-prof < %{xhtml_ver}-%{release} -%endif -%if %{without manual} -Obsoletes: %{name}-manual < %{version}-%{release} -%endif -%ifarch %{ghc_llvm_archs} -Requires: llvm%{llvm_major} -%endif -%obsoletes_ghcXY compiler - -%description compiler -The package contains the GHC compiler, tools and utilities. - -The ghc libraries are provided by %{name}-devel. -To install all of ghc (including the ghc library), -install the main ghc package. - - -%if %{with haddock} || (%{with hadrian} && %{with manual}) -%package doc -Summary: Haskell library documentation meta package -License: BSD-3-clause -%obsoletes_ghcXY doc - -%description doc -Installing this package causes %{name}-*-doc packages corresponding to -%{name}-*-devel packages to be automatically installed too. - - -%package doc-index -Summary: GHC library documentation indexing -License: BSD-3-clause -Obsoletes: ghc-doc-cron < %{version}-%{release} -Requires: %{name}-compiler = %{version}-%{release} -# due to disabled haddock archs -#BuildArch: noarch -%obsoletes_ghcXY doc-index - -%description doc-index -The package enables re-indexing of installed library documention. - - -%package filesystem -Summary: Shared directories for Haskell documentation -# due to disabled haddock archs -#BuildArch: noarch -Obsoletes: %{name}-filesystem < %{version}-%{release} -%obsoletes_ghcXY filesystem - -%description filesystem -This package provides some common directories used for -Haskell libraries documentation. -%endif - - -%if %{with manual} -%package manual -Summary: GHC manual -License: BSD-3-clause -BuildArch: noarch -Requires: %{name}-filesystem = %{version}-%{release} -%obsoletes_ghcXY manual - -%description manual -This package provides the User Guide and Haddock manual. -%endif - - -# ghclibdir also needs ghc_version_override for bootstrapping -%global ghc_version_override %{version} - -%if %{with hadrian} -%package hadrian -Summary: GHC Hadrian buildsystem tool -License: MIT -Version: 0.1.0.0 - -%description hadrian -This provides the hadrian tool which can be used to build ghc. -%endif - -%global BSDHaskellReport %{quote:BSD-3-clause and HaskellReport} - -# use "./libraries-versions.sh" to check versions -%if %{defined ghclibdir} -%ghc_lib_subpackage -d -l BSD-3-clause Cabal-3.6.3.0 -%ghc_lib_subpackage -d -l %BSDHaskellReport array-0.5.4.0 -%ghc_lib_subpackage -d -l %BSDHaskellReport -c gmp-devel%{?_isa},libffi-devel%{?_isa} base-%{base_ver} -%ghc_lib_subpackage -d -l BSD-3-clause binary-0.8.9.0 -%ghc_lib_subpackage -d -l BSD-3-clause bytestring-0.11.4.0 -%ghc_lib_subpackage -d -l %BSDHaskellReport containers-0.6.5.1 -%ghc_lib_subpackage -d -l %BSDHaskellReport deepseq-1.4.6.1 -%ghc_lib_subpackage -d -l %BSDHaskellReport directory-1.3.6.2 -%ghc_lib_subpackage -d -l %BSDHaskellReport exceptions-0.10.4 -%ghc_lib_subpackage -d -l BSD-3-clause filepath-1.4.2.2 -# in ghc not ghc-libraries: -%ghc_lib_subpackage -d -x ghc-%{ghc_version_override} -%ghc_lib_subpackage -d -x -l BSD-3-clause ghc-bignum-%{ghc_bignum_ver} -%ghc_lib_subpackage -d -x -l BSD-3-clause ghc-boot-%{ghc_version_override} -%ghc_lib_subpackage -d -l BSD-3-clause ghc-boot-th-%{ghc_version_override} -%ghc_lib_subpackage -d -x -l BSD-3-clause ghc-compact-%{ghc_compact_ver} -%ghc_lib_subpackage -d -x -l BSD-3-clause ghc-heap-%{ghc_version_override} -# see below for ghc-prim -%ghc_lib_subpackage -d -x -l BSD-3-clause ghci-%{ghc_version_override} -%ghc_lib_subpackage -d -l BSD-3-clause haskeline-0.8.2 -%ghc_lib_subpackage -d -x -l BSD-3-clause hpc-%{hpc_ver} -# see below for integer-gmp -%ghc_lib_subpackage -d -x -l %BSDHaskellReport libiserv-%{ghc_version_override} -%ghc_lib_subpackage -d -l BSD-3-clause mtl-2.2.2 -%ghc_lib_subpackage -d -l BSD-3-clause parsec-3.1.15.0 -%ghc_lib_subpackage -d -l BSD-3-clause pretty-1.1.3.6 -%ghc_lib_subpackage -d -l %BSDHaskellReport process-1.6.16.0 -%ghc_lib_subpackage -d -l BSD-3-clause stm-2.5.0.2 -%ghc_lib_subpackage -d -l BSD-3-clause template-haskell-2.18.0.0 -%ghc_lib_subpackage -d -l BSD-3-clause -c ncurses-devel%{?_isa} terminfo-0.4.1.5 -%ghc_lib_subpackage -d -l BSD-3-clause text-1.2.5.0 -%ghc_lib_subpackage -d -l BSD-3-clause time-1.11.1.1 -%ghc_lib_subpackage -d -l BSD-3-clause transformers-0.5.6.2 -%ghc_lib_subpackage -d -l BSD-3-clause unix-2.7.2.2 -%if %{with haddock} || %{with hadrian} -%ghc_lib_subpackage -d -l BSD-3-clause xhtml-%{xhtml_ver} -%endif -%endif - -%global version %{ghc_version_override} - -%package devel -Summary: GHC development libraries meta package -License: BSD-3-clause and HaskellReport -Requires: %{name}-compiler = %{version}-%{release} -Obsoletes: %{name}-libraries < %{version}-%{release} -Provides: %{name}-libraries = %{version}-%{release} -%{?ghc_packages_list:Requires: %(echo %{ghc_packages_list} | sed -e "s/\([^ ]*\)-\([^ ]*\)/%{name}-\1-devel = \2-%{release},/g")} -%obsoletes_ghcXY devel - -%description devel -This is a meta-package for all the development library packages in GHC -except the ghc library, which is installed by the toplevel ghc metapackage. - - -%if %{with ghc_prof} -%package prof -Summary: GHC profiling libraries meta package -License: BSD-3-clause -Requires: %{name}-compiler = %{version}-%{release} -%obsoletes_ghcXY prof - -%description prof -Installing this package causes %{name}-*-prof packages corresponding to -%{name}-*-devel packages to be automatically installed too. -%endif - - -%prep -%if %{with prodbuild} -#%%{gpgverify} --keyring='%{SOURCE3}' --signature='%{SOURCE2}' --data='%{SOURCE0}' -%endif -%setup -q -n ghc-%{version} %{?with_testsuite:-b1} - -%patch -P0 -p1 -b .orig -%patch -P1 -p1 -b .orig -%patch -P3 -p1 -b .orig - -%patch -P2 -p1 -b .orig -%patch -P9 -p1 -b .orig -%patch -P10 -p1 -b .orig -%patch -P11 -p1 -b .orig11 - -rm libffi-tarballs/libffi-*.tar.gz - -%ifarch armv7hl -%patch -P12 -p1 -b .orig -%endif - -# remove s390x after complete switching to llvm -%ifarch %{ghc_unregisterized_arches} s390x -%patch -P15 -p1 -b .orig -%patch -P16 -p1 -b .orig -%endif - -# bigendian -%ifarch s390x -%patch -P18 -p1 -b .orig -%endif - -# ppc64le -%patch -P20 -p1 -b .orig - -# debian -%patch -P24 -p1 -b .orig -%patch -P26 -p1 -b .orig -%patch -P27 -p1 -b .orig - -%if %{with haddock} && %{without hadrian} -%global gen_contents_index gen_contents_index.orig -if [ ! -f "libraries/%{gen_contents_index}" ]; then - echo "Missing libraries/%{gen_contents_index}, needed at end of %%install!" - exit 1 -fi -%endif - -%if %{without hadrian} -# https://gitlab.haskell.org/ghc/ghc/-/wikis/platforms -cat > mk/build.mk << EOF -%if %{with perf_build} -%ifarch %{ghc_llvm_archs} -BuildFlavour = perf-llvm -%else -%if %{with dwarf} -BuildFlavour = dwarf -%else -BuildFlavour = perf -%endif -%endif -%else -%ifarch %{ghc_llvm_archs} -BuildFlavour = quick-llvm -%else -BuildFlavour = quick -%endif -%endif -GhcLibWays = v dyn %{?with_ghc_prof:p} -%if %{with haddock} -HADDOCK_DOCS = YES -EXTRA_HADDOCK_OPTS += --hyperlinked-source --hoogle --quickjump -%else -HADDOCK_DOCS = NO -%endif -%if %{with manual} -BUILD_MAN = YES -BUILD_SPHINX_HTML = YES -%else -BUILD_MAN = NO -BUILD_SPHINX_HTML = NO -%endif -BUILD_SPHINX_PDF = NO -EOF -%endif - - -%build -# for patch11 -autoreconf - -%ghc_set_gcc_flags -export CC=%{_bindir}/gcc -# lld breaks build-id -# /usr/bin/debugedit: Cannot handle 8-byte build ID -# https://bugzilla.redhat.com/show_bug.cgi?id=2116508 -# https://gitlab.haskell.org/ghc/ghc/-/issues/22195 -export LD=%{_bindir}/ld.gold - -# * %%configure induces cross-build due to different target/host/build platform names -./configure --prefix=%{_prefix} --exec-prefix=%{_exec_prefix} \ - --bindir=%{_bindir} --sbindir=%{_sbindir} --sysconfdir=%{_sysconfdir} \ - --datadir=%{_datadir} --includedir=%{_includedir} --libdir=%{_libdir} \ - --libexecdir=%{_libexecdir} --localstatedir=%{_localstatedir} \ - --sharedstatedir=%{_sharedstatedir} --mandir=%{_mandir} \ - --docdir=%{_docdir}/%{name} \ - --with-system-libffi \ -%ifarch %{ghc_unregisterized_arches} - --enable-unregisterised \ -%endif - %{?with_dwarf:--enable-dwarf-unwind} \ -%{nil} - -# avoid "ghc: hGetContents: invalid argument (invalid byte sequence)" -export LANG=C.utf8 -%if %{with hadrian} -%if %{defined _ghcdynlibdir} -%undefine _ghcdynlibdir -%endif - -%if %{with build_hadrian} -# do not disable debuginfo with ghc_bin_build -%global ghc_debuginfo 1 -( -cd hadrian -%ghc_bin_build -) -%global hadrian hadrian/dist/build/hadrian/hadrian -%else -%global hadrian %{_bindir}/hadrian -%endif - -%ifarch %{ghc_llvm_archs} -%global hadrian_llvm +llvm -%endif -%define hadrian_docs %{!?with_haddock:--docs=no-haddocks} %{!?with_manual:--docs=no-sphinx}%{?with_manual:--docs=no-sphinx-pdfs} -# quickest does not build shared libs -%{hadrian} %{?_smp_mflags} --flavour=%{!?with_prodbuild:quick+no_profiled_libs}%{?with_prodbuild:perf%{!?with_ghc_prof:+no_profiled_libs}}%{?hadrian_llvm} %{hadrian_docs} binary-dist-dir -%else -make %{?_smp_mflags} -%endif - - -%install -%if %{with hadrian} -%if %{with build_hadrian} -( -cd hadrian -%ghc_bin_install -rm %{buildroot}%{_ghclicensedir}/%{name}/LICENSE -cp -p LICENSE ../LICENSE.hadrian -) -%endif -# https://gitlab.haskell.org/ghc/ghc/-/issues/20120#note_366872 -( -cd _build/bindist/ghc-%{version}-* -./configure --prefix=%{buildroot}%{ghclibdir} --bindir=%{buildroot}%{_bindir} --libdir=%{buildroot}%{_libdir} --mandir=%{buildroot}%{_mandir} --docdir=%{buildroot}%{_docdir}/%{name} -make install -) -%else -make DESTDIR=%{buildroot} install -%if %{defined _ghcdynlibdir} -mv %{buildroot}%{ghclibdir}/*/libHS*ghc%{ghc_version}.so %{buildroot}%{_ghcdynlibdir}/ -for i in %{buildroot}%{ghclibdir}/package.conf.d/*.conf; do - sed -i -e 's!^dynamic-library-dirs: .*!dynamic-library-dirs: %{_ghcdynlibdir}!' $i -done -sed -i -e 's!^library-dirs: %{ghclibdir}/rts!&\ndynamic-library-dirs: %{_ghcdynlibdir}!' %{buildroot}%{ghclibdir}/package.conf.d/rts.conf -%endif -%endif - -# https://bugzilla.redhat.com/show_bug.cgi?id=2166028 -%if "%{?_ghcdynlibdir}" != "%_libdir" -mkdir -p %{buildroot}%{_sysconfdir}/ld.so.conf.d -echo "%{?_ghcdynlibdir}%{!?_ghcdynlibdir:%{ghclibplatform}}" > %{buildroot}%{_sysconfdir}/ld.so.conf.d/%{name}.conf -%else -for i in $(find %{buildroot} -type f -executable -exec sh -c "file {} | grep -q 'dynamically linked'" \; -print); do - chrpath -d $i -done -%endif - -# containers src moved to a subdir -cp -p libraries/containers/containers/LICENSE libraries/containers/LICENSE - -rm -f %{name}-*.files - -# FIXME replace with ghc_subpackages_list -for i in %{ghc_packages_list}; do -name=$(echo $i | sed -e "s/\(.*\)-.*/\1/") -ver=$(echo $i | sed -e "s/.*-\(.*\)/\1/") -%ghc_gen_filelists $name $ver -echo "%%license libraries/$name/LICENSE" >> %{name}-$name.files -done - -echo "%%dir %{ghclibdir}" >> %{name}-base%{?_ghcdynlibdir:-devel}.files - -%ghc_gen_filelists ghc %{ghc_version_override} -%ghc_gen_filelists ghc-bignum %{ghc_bignum_ver} -%ghc_gen_filelists ghc-boot %{ghc_version_override} -%ghc_gen_filelists ghc-compact %{ghc_compact_ver} -%ghc_gen_filelists ghc-heap %{ghc_version_override} -%ghc_gen_filelists ghci %{ghc_version_override} -%ghc_gen_filelists hpc %{hpc_ver} -%ghc_gen_filelists libiserv %{ghc_version_override} - -%ghc_gen_filelists ghc-prim 0.8.0 -%ghc_gen_filelists integer-gmp 1.1 -%if %{with hadrian} -%ghc_gen_filelists rts %{rts_ver} -%endif - -# move to ghc-rpm-macro -%define merge_filelist()\ -cat %{name}-%1.files >> %{name}-%2.files\ -cat %{name}-%1-devel.files >> %{name}-%2-devel.files\ -%if %{with haddock}\ -cat %{name}-%1-doc.files >> %{name}-%2-doc.files\ -%endif\ -%if %{with ghc_prof}\ -cat %{name}-%1-prof.files >> %{name}-%2-prof.files\ -%endif\ -if [ "%1" != "rts" ]; then\ -cp -p libraries/%1/LICENSE libraries/LICENSE.%1\ -echo "%%license libraries/LICENSE.%1" >> %{name}-%2.files\ -fi\ -%{nil} - -%merge_filelist ghc-prim base -%merge_filelist integer-gmp base -%if %{with hadrian} -%merge_filelist rts base -%endif - -%if "%{?_ghcdynlibdir}" != "%_libdir" -echo "%{_sysconfdir}/ld.so.conf.d/%{name}.conf" >> %{name}-base.files -%endif - -# add rts libs -%if %{with hadrian} -for i in %{buildroot}%{ghclibplatform}/libHSrts*ghc%{ghc_version}.so; do -if [ "$(basename $i)" != "libHSrts-%{rts_ver}-ghc%{ghc_version}.so" ]; then -echo $i >> %{name}-base.files -fi -done -%else -%if %{defined _ghcdynlibdir} -echo "%{ghclibdir}/rts" >> %{name}-base-devel.files -%else -echo "%%dir %{ghclibdir}/rts" >> %{name}-base.files -ls -d %{buildroot}%{ghclibdir}/rts/lib*.a >> %{name}-base-devel.files -%endif -ls %{buildroot}%{?_ghcdynlibdir}%{!?_ghcdynlibdir:%{ghclibdir}/rts}/libHSrts*.so >> %{name}-base.files -%if %{defined _ghcdynlibdir} -sed -i -e 's!^library-dirs: %{ghclibdir}/rts!&\ndynamic-library-dirs: %{_libdir}!' %{buildroot}%{ghclibdir}/package.conf.d/rts.conf -%endif -ls -d %{buildroot}%{ghclibdir}/package.conf.d/rts.conf >> %{name}-base-devel.files -%endif - -ls -d %{buildroot}%{ghclibdir}/include >> %{name}-base-devel.files - -%if %{with ghc_prof} -ls %{buildroot}%{ghclibdir}/bin/ghc-iserv-prof* >> %{name}-base-prof.files -%if %{with hadrian} -ls %{buildroot}%{ghcliblib}/bin/ghc-iserv-prof >> %{name}-base-prof.files -%endif -%endif - -sed -i -e "s|^%{buildroot}||g" %{name}-base*.files -%if %{with hadrian} -sed -i -e "s|%{buildroot}||g" %{buildroot}%{_bindir}/* -%endif - -%if %{with haddock} && %{without hadrian} -# generate initial lib doc index -cd libraries -sh %{gen_contents_index} --intree --verbose -cd .. -%endif - -mkdir -p %{buildroot}%{_mandir}/man1 -install -p -m 0644 %{SOURCE5} %{buildroot}%{_mandir}/man1/ghc-pkg.1 -install -p -m 0644 %{SOURCE6} %{buildroot}%{_mandir}/man1/haddock.1 -install -p -m 0644 %{SOURCE7} %{buildroot}%{_mandir}/man1/runghc.1 - -%if %{with hadrian} -%if %{with haddock} -rm %{buildroot}%{_pkgdocdir}/archives/libraries.html.tar.xz -%endif -%if %{with manual} -rm %{buildroot}%{_pkgdocdir}/archives/Haddock.html.tar.xz -rm %{buildroot}%{_pkgdocdir}/archives/users_guide.html.tar.xz -mv %{buildroot}%{_ghc_doc_dir}/users_guide/build-man/ghc.1 %{buildroot}%{_mandir}/man1/ -%endif -%endif - -# we package the library license files separately -%if %{without hadrian} -find %{buildroot}%{ghc_html_libraries_dir} -name LICENSE -exec rm '{}' ';' -%endif - -%ifarch armv7hl -export RPM_BUILD_NCPUS=1 -%endif - -%if %{with hadrian} -rm %{buildroot}%{ghcliblib}/package.conf.d/.stamp -rm %{buildroot}%{ghcliblib}/package.conf.d/*.conf.copy - -(cd %{buildroot}%{ghcliblib}/bin -for i in *; do -if [ -f %{buildroot}%{ghclibdir}/bin/$i ]; then -ln -sf ../../bin/$i -fi -done -) -%endif - -%if %{defined ghc_major} -( -cd %{buildroot}%{_bindir} -for i in *; do - case $i in - *-%{version}) ;; - *) - if [ -f $i-%{version} ]; then - ln -s $i-%{version} $i-%{ghc_major} - fi - esac -done -) -%endif - -# bash completion -mkdir -p %{buildroot}%{_datadir}/bash-completion/completions/ -cp -p utils/completion/ghc.bash %{buildroot}%{_datadir}/bash-completion/completions/%{name} - - -%check -export LANG=C.utf8 -# stolen from ghc6/debian/rules: -%if %{with hadrian} -export LD_LIBRARY_PATH=%{buildroot}%{ghclibplatform}: -GHC=%{buildroot}%{ghclibdir}/bin/ghc -%else -GHC=inplace/bin/ghc-stage2 -%endif -# Do some very simple tests that the compiler actually works -rm -rf testghc -mkdir testghc -echo 'main = putStrLn "Foo"' > testghc/foo.hs -$GHC testghc/foo.hs -o testghc/foo -[ "$(testghc/foo)" = "Foo" ] -rm testghc/* -echo 'main = putStrLn "Foo"' > testghc/foo.hs -$GHC testghc/foo.hs -o testghc/foo -O2 -[ "$(testghc/foo)" = "Foo" ] -rm testghc/* -echo 'main = putStrLn "Foo"' > testghc/foo.hs -$GHC testghc/foo.hs -o testghc/foo -dynamic -[ "$(testghc/foo)" = "Foo" ] -rm testghc/* - -$GHC --info - -# check the ABI hashes -%if %{with abicheck} -if [ "%{version}" = "$(ghc --numeric-version)" ]; then - echo "Checking package ABI hashes:" - for i in %{ghc_packages_list}; do - old=$(ghc-pkg field $i id --simple-output || :) - if [ -n "$old" ]; then - new=$(/usr/lib/rpm/ghc-pkg-wrapper %{buildroot}%{ghclibdir} field $i id --simple-output) - if [ "$old" != "$new" ]; then - echo "ABI hash for $i changed!:" >&2 - echo " $old -> $new" >&2 - ghc_abi_hash_change=yes - else - echo "($old unchanged)" - fi - else - echo "($i not installed)" - fi - done - if [ "$ghc_abi_hash_change" = "yes" ]; then - echo "ghc ABI hash change: aborting build!" >&2 - exit 1 - fi -else - echo "ABI hash checks skipped: GHC changed from $(ghc --numeric-version) to %{version}" -fi -%endif - -%if %{with testsuite} -make test -%endif - - -%if %{defined ghclibdir} -%if "%{?_ghcdynlibdir}" != "%_libdir" -%post base -p /sbin/ldconfig -%postun base -p /sbin/ldconfig -%endif - - -%transfiletriggerin compiler -- %{ghcliblib}/package.conf.d -%ghc_pkg_recache -%end - -%transfiletriggerpostun compiler -- %{ghcliblib}/package.conf.d -%ghc_pkg_recache -%end - - -%if %{with haddock} && %{without hadrian} -%transfiletriggerin doc-index -- %{ghc_html_libraries_dir} -env -C %{ghc_html_libraries_dir} ./gen_contents_index -%end - -%transfiletriggerpostun doc-index -- %{ghc_html_libraries_dir} -env -C %{ghc_html_libraries_dir} ./gen_contents_index -%end -%endif -%endif - - -%files - -%files compiler -%license LICENSE -%doc README.md -%{_bindir}/ghc -%{_bindir}/ghc-%{version} -%{_bindir}/ghc-pkg -%{_bindir}/ghc-pkg-%{version} -%{_bindir}/ghci -%{_bindir}/ghci-%{version} -%{_bindir}/hp2ps -%{_bindir}/hp2ps-%{?with_hadrian:ghc-}%{version} -%{_bindir}/hpc -%{_bindir}/hpc-%{?with_hadrian:ghc-}%{version} -%{_bindir}/hsc2hs -%{_bindir}/hsc2hs-%{?with_hadrian:ghc-}%{version} -%{_bindir}/runghc -%{_bindir}/runghc-%{ghc_version} -%{_bindir}/runhaskell -%{_bindir}/runhaskell-%{version} -%if %{defined ghc_major} -%{_bindir}/ghc-%{ghc_major} -%{_bindir}/ghc-pkg-%{ghc_major} -%{_bindir}/ghci-%{ghc_major} -%{_bindir}/runghc-%{ghc_major} -%{_bindir}/runhaskell-%{ghc_major} -%if %{without hadrian} -%{_bindir}/hp2ps-%{ghc_major} -%{_bindir}/hpc-%{ghc_major} -%{_bindir}/hsc2hs-%{ghc_major} -%endif -%endif -%dir %{ghclibdir}/bin -%{ghclibdir}/bin/ghc -%{ghclibdir}/bin/ghc-iserv -%{ghclibdir}/bin/ghc-iserv-dyn -%{ghclibdir}/bin/ghc-pkg -%{ghclibdir}/bin/hpc -%{ghclibdir}/bin/hsc2hs -%{ghclibdir}/bin/runghc -%{ghclibdir}/bin/hp2ps -%{ghclibdir}/bin/unlit -%if %{with hadrian} -%{ghclibdir}/bin/ghc-%{version} -%{ghclibdir}/bin/ghc-iserv-ghc-%{version} -%{ghclibdir}/bin/ghc-iserv-dyn-ghc-%{version} -%{ghclibdir}/bin/ghc-pkg-%{version} -%{ghclibdir}/bin/haddock -%{ghclibdir}/bin/haddock-ghc-%{version} -%{ghclibdir}/bin/hp2ps-ghc-%{version} -%{ghclibdir}/bin/hpc-ghc-%{version} -%{ghclibdir}/bin/hsc2hs-ghc-%{version} -%{ghclibdir}/bin/runghc-%{version} -%{ghclibdir}/bin/runhaskell -%{ghclibdir}/bin/runhaskell-%{version} -%{ghclibdir}/bin/unlit-ghc-%{version} -%dir %{ghcliblib} -%dir %{ghcliblib}/bin -%{ghcliblib}/bin/ghc-iserv -%{ghcliblib}/bin/ghc-iserv-dyn -%{ghcliblib}/bin/unlit -%{ghcliblib}/DerivedConstants.h -%{ghcliblib}/ghcautoconf.h -%{ghcliblib}/ghcplatform.h -%{ghcliblib}/ghcversion.h -%dir %ghclibplatform -%endif -%{ghcliblib}/ghc-usage.txt -%{ghcliblib}/ghci-usage.txt -%{ghcliblib}/llvm-passes -%{ghcliblib}/llvm-targets -%dir %{ghcliblib}/package.conf.d -%ghost %{ghcliblib}/package.conf.d/package.cache -%{ghcliblib}/package.conf.d/package.cache.lock -%{ghcliblib}/settings -%{ghcliblib}/template-hsc.h -%{_datadir}/bash-completion/completions/%{name} -%{_mandir}/man1/ghc-pkg.1* -%{_mandir}/man1/haddock.1* -%{_mandir}/man1/runghc.1* - -%if %{with hadrian} || %{with haddock} -%{_bindir}/haddock -%{_bindir}/haddock-ghc-%{version} -%{ghcliblib}/html -%{ghcliblib}/latex -%endif -%if %{with haddock} -%if %{without hadrian} -%{ghclibdir}/bin/haddock -%{ghc_html_libraries_dir}/prologue.txt -%endif -%verify(not size mtime) %{ghc_html_libraries_dir}/haddock-bundle.min.js -%verify(not size mtime) %{ghc_html_libraries_dir}/linuwial.css -%verify(not size mtime) %{ghc_html_libraries_dir}/quick-jump.css -%verify(not size mtime) %{ghc_html_libraries_dir}/synopsis.png -%endif -%if %{with manual} -%{_mandir}/man1/ghc.1* -%endif - -%files devel - -%if %{with haddock} || (%{with hadrian} && %{with manual}) -%files doc -%{ghc_html_dir}/index.html - -%files doc-index -%if %{with haddock} -#%%{ghc_html_libraries_dir}/gen_contents_index -%verify(not size mtime) %{ghc_html_libraries_dir}/doc-index*.html -%verify(not size mtime) %{ghc_html_libraries_dir}/index*.html -%endif - -%files filesystem -%dir %_ghc_doc_dir -%dir %ghc_html_dir -%if %{with haddock} -%dir %ghc_html_libraries_dir -%endif -%endif - -%if %{with hadrian} && %{with build_hadrian} -%files hadrian -%license LICENSE.hadrian -%{_bindir}/hadrian -%endif - -%if %{with manual} -%files manual -## needs pandoc -#%%{ghc_html_dir}/Cabal -%{ghc_html_dir}/index.html -%{ghc_html_dir}/users_guide -%if %{with hadrian} -%{ghc_html_dir}/Haddock -%else -%if %{with haddock} -%{ghc_html_dir}/haddock -%endif -%endif -%endif - -%if %{with ghc_prof} -%files prof -%endif - - -%changelog -* Thu May 25 2023 Jens Petersen - 9.2.6-131 -- include backport of 9.4 m32_allocator_init changes by Sylvain Henry (#2209162) -- SPDX migration of license tags - -* Mon Mar 13 2023 Jens Petersen - 9.2.6-130 -- allow parallel installing ghc9.2-9.2.7 - -* Fri Feb 17 2023 Jens Petersen - 9.2.6-129 -- upstream patch to enable SMP rts for ppc64le - -* Thu Feb 16 2023 Jens Petersen - 9.2.6-128 -- rebuild to fix prof deps - -* Sat Feb 11 2023 Jens Petersen - 9.2.6-127 -- https://downloads.haskell.org/~ghc/9.2.6/docs/html/users_guide/9.2.6-notes.html -- restore RUNPATHs to help dependency generation - -* Sat Feb 4 2023 Jens Petersen - 9.2.5-126 -- add back ld.so.conf.d file to workaround mock install issue (#2166028) -- remove the RUNPATHs again since they are covered by the ld.so.conf.d file - -* Mon Jan 30 2023 Jens Petersen - 9.2.5-125 -- rebase to ghc-9.2.5 from ghc9.2 -- https://www.haskell.org/ghc/blog/20221107-ghc-9.2.5-released.html -- https://downloads.haskell.org/~ghc/9.2.5/docs/html/users_guide/9.2.1-notes.html -- fully Obsoletes ghc9.2* -- install bash-completion file - -* Sun Jan 15 2023 Jens Petersen - 9.0.2-124 -- rebase to 9.0.2 from ghc9.0 -- https://downloads.haskell.org/~ghc/9.0.2/docs/html/users_guide/9.0.1-notes.html -- https://downloads.haskell.org/~ghc/9.0.2/docs/html/users_guide/9.0.2-notes.html -- add buildpath-abi-stability-2.patch and haddock-remove-googleapis-fonts.patch - from Debian - -* Thu Jan 12 2023 Florian Weimer - 8.10.7-123 -- Port configure script to C99 - -* Fri Jan 6 2023 Jens Petersen - 8.10.7-122 -- obsoletes ghc8.10 -- use llvm 12 (for ARM) - -* Sat Aug 6 2022 Jens Petersen - 8.10.7-121 -- ghc-compiler conflicts with ghc8.10-compiler-8.10.7 - -* Sat Aug 6 2022 Jens Petersen - 8.10.7-120 -- conflicts with ghc8.10-8.10.7 -- add ghc-filesystem obsoletes to help dnf - -* Thu Jul 21 2022 Fedora Release Engineering - 8.10.7-119 -- Rebuilt for https://fedoraproject.org/wiki/Fedora_37_Mass_Rebuild - -* Tue Jun 14 2022 Jens Petersen - 8.10.7-118 -- https://downloads.haskell.org/~ghc/8.10.7/docs/html/users_guide/8.10.7-notes.html -- add filesystem subpackage - -* Thu Jan 20 2022 Fedora Release Engineering - 8.10.5-117 -- Rebuilt for https://fedoraproject.org/wiki/Fedora_36_Mass_Rebuild - -* Sat Jan 08 2022 Miro Hrončok - 8.10.5-116 -- Rebuilt for https://fedoraproject.org/wiki/Changes/LIBFFI34 - -* Fri Sep 17 2021 Jens Petersen -- move zlib-devel Recommends to cabal-install - -* Thu Jul 22 2021 Jens Petersen - 8.10.5-115 -- update to 8.10.5 with patch for missing rts symbols -- use llvm 11 for ARM -- https://downloads.haskell.org/~ghc/8.10.5/docs/html/users_guide/8.10.5-notes.html - -* Thu Jul 15 2021 Jens Petersen - 8.10.4-114 -- perf build - -* Thu Jul 15 2021 Jens Petersen - 8.10.4-113 -- rebase to 8.10.4 from ghc:8.10 module stream -- https://downloads.haskell.org/ghc/8.10.4/docs/html/users_guide/8.10.1-notes.html -- use llvm10 for ARM - -* Wed Jun 30 2021 Jens Petersen - 8.8.4-111 -- fix build with sphinx4 (#1977317) - -* Tue May 25 2021 Jens Petersen - 8.8.4-110 -- ghc-compiler now requires ghc-filesystem for html docdirs - -* Tue Jan 26 2021 Fedora Release Engineering - 8.8.4-109 -- Rebuilt for https://fedoraproject.org/wiki/Fedora_34_Mass_Rebuild - -* Wed Dec 02 2020 David Abdurachmanov -- Add riscv64 to ghc_unregisterized_arches - -* Tue Aug 18 2020 Troy Dawson - 8.8.4-108 -- Cleanup old %if statements - -* Mon Jul 27 2020 Fedora Release Engineering - 8.8.4-107 -- Rebuilt for https://fedoraproject.org/wiki/Fedora_33_Mass_Rebuild - -* Thu Jul 16 2020 Jens Petersen - 8.8.4-106 -- 8.8.4 bugfix releases -- https://downloads.haskell.org/ghc/8.8.4/docs/html/users_guide/8.8.4-notes.html -- bytestring-0.10.10.1 and process-1.6.9.0 - -* Tue Jul 14 2020 Jens Petersen - 8.8.3-105 -- rebase to 8.8.3 from ghc:8.8 module stream -- https://downloads.haskell.org/ghc/8.8.1/docs/html/users_guide/8.8.1-notes.html -- https://downloads.haskell.org/ghc/8.8.2/docs/html/users_guide/8.8.2-notes.html -- https://downloads.haskell.org/ghc/8.8.3/docs/html/users_guide/8.8.3-notes.html - -* Mon Jul 6 2020 Jens Petersen - 8.6.5-104 -- use python3-sphinx also for rhel8 - -* Thu Apr 9 2020 Jens Petersen - 8.6.5-103 -- fix running of gen_contents_index when no haddocks (#1813548) - -* Mon Feb 10 2020 Jens Petersen - 8.6.5-102 -- rebuild against ghc-rpm-macros fixed for subpackage prof deps - -* Tue Jan 28 2020 Fedora Release Engineering - 8.6.5-101 -- Rebuilt for https://fedoraproject.org/wiki/Fedora_32_Mass_Rebuild - -* Wed Jul 31 2019 Jens Petersen - 8.6.5-100 -- update to GHC 8.6.5 (backport ghc:8.6 module stream) -- https://downloads.haskell.org/~ghc/8.6.5/docs/html/users_guide/8.6.1-notes.html -- https://downloads.haskell.org/~ghc/8.6.5/docs/html/users_guide/8.6.2-notes.html -- https://downloads.haskell.org/~ghc/8.6.5/docs/html/users_guide/8.6.3-notes.html -- https://downloads.haskell.org/~ghc/8.6.5/docs/html/users_guide/8.6.4-notes.html -- https://downloads.haskell.org/~ghc/8.6.5/docs/html/users_guide/8.6.5-notes.html -- fix process library initgroups issue - (https://github.com/haskell/process/pull/148) -- add fix-build-using-unregisterized-v8.4.patch for s390x (#1648537) - https://gitlab.haskell.org/ghc/ghc/issues/15913 -- add bigendian patch for containers (#1651448) - https://gitlab.haskell.org/ghc/ghc/issues/15411 -- Debian patches: - - add_-latomic_to_ghc-prim.patch, - - rts osReserveHeapMemory block alignment - -* Tue Jul 30 2019 Jens Petersen - 8.4.4-99 -- subpackage library haddock documentation and profiling libraries -- add ghc-doc and ghc-prof metapackages to pull in lib docs and prof libs -- rename ghc-doc-cron with ghc-doc-index using file triggers -- rename ghc-libraries to ghc-devel -- for quickbuild disable debuginfo -- lock ghc-compiler requires ghc-base-devel to ver-rel -- drop alternatives for runhaskell and hsc2hs -- use ghc_set_gcc_flags, with_ghc_prof, and with_haddock - -* Thu Jul 25 2019 Fedora Release Engineering -- Rebuilt for https://fedoraproject.org/wiki/Fedora_31_Mass_Rebuild - -* Fri Jun 28 2019 Jens Petersen - 8.4.4-75 -- add transfiletriggers that will replace individual post/postun scriptlets - -* Mon Mar 4 2019 Jens Petersen - 8.4.4-74 -- unregisterized: fix 32bit adjacent floats issue - (https://ghc.haskell.org/trac/ghc/ticket/15853) - -* Sat Feb 16 2019 Jens Petersen - 8.4.4-73 -- update to GHC 8.4 -- https://ghc.haskell.org/trac/ghc/blog/ghc-8.4.1-released -- new patches: - - 6e361d895dda4600a85e01c72ff219474b5c7190.patch - - fix-build-using-unregisterized-v8.2.patch - - ghc-sphinx-1.8-4eebc8016.patch -- dropped patch: - - D4159.patch - - ghc-7.8-arm7_saner-linker-opt-handling-9873.patch - - ghc-Debian-reproducible-tmp-names.patch -- rely on rpm to strip - -* Fri Feb 8 2019 Jens Petersen - 8.2.2-72 -- add ghc_unregisterized_arches -- Recommends zlib-devel -- epel6 tweaks - -* Thu Jan 31 2019 Fedora Release Engineering - 8.2.2-72 -- Rebuilt for https://fedoraproject.org/wiki/Fedora_30_Mass_Rebuild - -* Sun Nov 18 2018 Zbigniew Jędrzejewski-Szmek - 8.2.2-71 -- Use C.UTF-8 locale - See https://fedoraproject.org/wiki/Changes/Remove_glibc-langpacks-all_from_buildroot - -* Mon Oct 22 2018 Jens Petersen -- Recommends for ghc-manual and ghc-doc-cron - -* Wed Oct 17 2018 Jens Petersen - 8.2.2-70 -- backport quickbuild config from 8.4 module and extend to perf_build -- disable -Wall on s390x like in 8.4 module to silence warning flood - and simplify setting of CFLAGS -- enable buildpath-abi-stability.patch (from Debian) -- setup build.mk in setup section, taken from copr and module - -* Tue Oct 16 2018 Peter Robinson -- Update alternatives dependencies - -* Fri Jul 13 2018 Fedora Release Engineering - 8.2.2-69 -- Rebuilt for https://fedoraproject.org/wiki/Fedora_29_Mass_Rebuild - -* Mon May 28 2018 Jens Petersen - 8.2.2-68 -- fix sphinx-build version detection -- merge bcond for haddock and manual -- disable the testsuite to speed up builds -- version bootstrap and packaging fixes and tweaks - -* Mon May 28 2018 Jens Petersen - 8.2.2-67 -- move manuals to new ghc-manual (noarch) -- rename ghc-doc-index to ghc-doc-cron (noarch) -- ghost the ghc-doc-index local state files -- ghost some newer libraries index files -- simplify and extend bcond for build configuration -- drop bootstrap builds and do ABI hash checks unless ghc version changed -- no longer need autotools on aarch64 - -* Tue Apr 10 2018 Jens Petersen - 8.2.2-66 -- ghc-pkg: silence the abi-depends warnings - -* Fri Feb 09 2018 Igor Gnatenko - 8.2.2-65 -- Escape macros in %%changelog - -* Wed Feb 07 2018 Fedora Release Engineering - 8.2.2-64 -- Rebuilt for https://fedoraproject.org/wiki/Fedora_28_Mass_Rebuild - -* Tue Jan 30 2018 Jens Petersen - 8.2.2-63 -- apply Phabricator D4159.patch to workaround - https://ghc.haskell.org/trac/ghc/ticket/14381 - -* Thu Jan 25 2018 Jens Petersen - 8.2.2-62 -- 8.2.2 perf build -- https://downloads.haskell.org/~ghc/8.2.2/docs/html/users_guide/8.2.1-notes.html -- https://downloads.haskell.org/~ghc/8.2.2/docs/html/users_guide/8.2.2-notes.html - -* Wed Jan 24 2018 Jens Petersen - 8.2.2-61 -- 8.2.2 bootstrap build -- install ghc libs in libdir and remove RUNPATHs -- add shadowed-deps.patch (haskell/cabal#4728) -- new ghc-compact library -- exclude ghc-boot for ghc-libraries - -* Thu Oct 26 2017 Jens Petersen - 8.0.2-60 -- fix space in BSDHaskellReport license macro for rpm-4.14 -- mark other subpackages correctly as BSD license -- drop ghc-boot from ghc-libraries - -* Wed Aug 02 2017 Fedora Release Engineering - 8.0.2-59 -- Rebuilt for https://fedoraproject.org/wiki/Fedora_27_Binutils_Mass_Rebuild - -* Wed Jul 26 2017 Fedora Release Engineering - 8.0.2-58 -- Rebuilt for https://fedoraproject.org/wiki/Fedora_27_Mass_Rebuild - -* Fri Feb 17 2017 Jens Petersen - 8.0.2-57 -- 8.0.2 perf build -- http://downloads.haskell.org/~ghc/8.0.2/docs/html/users_guide/8.0.1-notes.html -- http://downloads.haskell.org/~ghc/8.0.2/docs/html/users_guide/8.0.2-notes.html - -* Fri Feb 17 2017 Jens Petersen - 8.0.2-56 -- update to GHC 8.0 (bootstrap build) -- backport changes from http://github.com/fedora-haskell/ghc - adding some new patches from Debian -- use llvm3.7 on ARM archs -- user guide now built with sphinx - -* Mon Feb 13 2017 Jens Petersen - 7.10.3-55 -- use new ghc_lib_subpackage -d option to fix handling of .files -- configure llc-3.5 and opt-3.5 explicitly for all arch's - -* Fri Feb 10 2017 Fedora Release Engineering - 7.10.3-54 -- Rebuilt for https://fedoraproject.org/wiki/Fedora_26_Mass_Rebuild - -* Thu Jan 12 2017 Igor Gnatenko - 7.10.3-53 -- Rebuild for readline 7.x - -* Wed Oct 26 2016 Jens Petersen - 7.10.3-52 -- use license macro -- update subpackaging for latest ghc-rpm-macros -- minor spec file cleanups -- drop old dph and feldspar obsoletes -- obsoletes ghc-doc-index when without_haddock -- BR perl - -* Tue Jul 12 2016 Jens Petersen - 7.10.3-51 -- obsolete haskell98 and haskell2010 -- add an ABI change check to prevent unexpected ghc package hash changes - -* Fri Jun 3 2016 Jens Petersen - 7.10.3-50 -- perf build -- http://downloads.haskell.org/~ghc/7.10.3/docs/html/users_guide/release-7-10-1.html -- http://downloads.haskell.org/~ghc/7.10.3/docs/html/users_guide/release-7-10-2.html -- http://downloads.haskell.org/~ghc/7.10.3/docs/html/users_guide/release-7-10-3.html - -* Wed Jun 1 2016 Jens Petersen - 7.10.3-49 -- quick build -- use 7.10.3b respin tarballs -- no longer need: - - ghc-glibc-2.20_BSD_SOURCE.patch - - ghc-7.8-arm-use-ld-gold.patch - - ghc-7.8-arm7_saner-linker-opt-handling-9873.patch - - ghc-config.mk.in-Enable-SMP-and-GHCi-support-for-Aarch64.patch - - build_minimum_smp -- add Debian packages: - - buildpath-abi-stability - - no-missing-haddock-file-warning - - reproducible-tmp-names -- use llvm35 -- add libraries-versions.sh script -- all library versions updates except xhtml -- BR ghc-rpm-macros-extra for all OS versions -- support building on EL6 -- deprecated libraries: haskell2010, haskell98, old-locale, old-time -- symlink for integer-gmp2 -- add llvm_major - -* Tue Mar 8 2016 Michal Toman - 7.8.4-48 -- do not package ghc-split on MIPS (#1294873) - -* Wed Feb 03 2016 Fedora Release Engineering - 7.8.4-47 -- Rebuilt for https://fedoraproject.org/wiki/Fedora_24_Mass_Rebuild - -* Tue Jun 16 2015 Jens Petersen - 7.8.4-46 -- rebuild - -* Thu Jun 11 2015 Jens Petersen - 7.8.4-45 -- use ld.gold on aarch64 like for armv7 (Erik de Castro Lopo, #1195231) - -* Wed Apr 22 2015 Jens Petersen - 7.8.4-44 -- turn on SMP and ghci for aarch64 (Erik de Castro Lopo, #1203951) -- use "make -j2" for s390 (#1212374) - -* Mon Mar 30 2015 Jens Petersen - 7.8.4-43 -- aarch64 production build - -* Mon Mar 23 2015 Jens Petersen - 7.8.4-42.2 -- aarch64 bootstrap build -- must use "make -j16" for Intel arches to preserve ABI hashes - (-j12 changed array's hash on i686) - -* Wed Mar 18 2015 Jens Petersen - 7.8.4-42.1 -- fix build.mk BuildFlavour setup -- improve the smp make setup with build_minimum_smp -- bootstrap for aarch64 without ghci (#1195231) -- disable ld hardening for F23 on 64bit and armv7hl - -* Sat Feb 14 2015 Jens Petersen - 7.8.4-42 -- try "make -j16" on Intel arches to keep ABI hashes same as -40 - -* Mon Feb 9 2015 Jens Petersen - 7.8.4-41 -- update the arm64 patch for 7.8.4 -- all archs have bindir/ghci - -* Sun Jan 18 2015 Jens Petersen - 7.8.4-40 -- production build -- version doc htmldirs again - -* Sat Jan 17 2015 Jens Petersen - 7.8.4-39 -- update to 7.8.4 -- bump release over haskell-platform xhtml -- https://www.haskell.org/ghc/docs/7.8.4/html/users_guide/release-7-8-1.html -- https://www.haskell.org/ghc/docs/7.8.4/html/users_guide/release-7-8-2.html -- https://www.haskell.org/ghc/docs/7.8.4/html/users_guide/release-7-8-3.html -- https://www.haskell.org/ghc/docs/7.8.4/html/users_guide/release-7-8-4.html -- bootstrap build -- provides haskeline, terminfo and xhtml libraries -- shared libraries on all archs -- bindir/ghci only on ghc_arches_with_ghci -- use ld.gold on ARMv7 (see https://ghc.haskell.org/trac/ghc/ticket/8976) - [thanks to Joachim Breitner for workaround patches posted upstream] - -* Tue Nov 18 2014 Jens Petersen - 7.6.3-28 -- remove the build hack to switch from llvm to llvm34 (#1161049) -- use rpm internal dependency generator with ghc.attr on F21+ -- fix bash-ism in ghc-doc-index (#1146733) -- do "quick" build when bootstrapping -- setup LDFLAGS - -* Mon Nov 17 2014 Jens Petersen - 7.6.3-27 -- use llvm34 instead of llvm-3.5 for arm (#1161049) - -* Sat Aug 16 2014 Fedora Release Engineering - 7.6.3-26 -- Rebuilt for https://fedoraproject.org/wiki/Fedora_21_22_Mass_Rebuild - -* Tue Jul 15 2014 Jens Petersen - 7.6.3-25 -- configure ARM with VFPv3D16 and without NEON (#995419) -- only apply the Cabal unversion docdir patch to F21 and later -- hide llvm version warning on ARM now up to 3.4 - -* Fri Jun 6 2014 Jens Petersen - 7.6.3-24 -- add aarch64 with Debian patch by Karel Gardas and Colin Watson -- patch Stg.h to define _DEFAULT_SOURCE instead of _BSD_SOURCE to quieten - glibc 2.20 warnings (see #1067110) - -* Fri May 30 2014 Jens Petersen - 7.6.3-23 -- bump release - -* Fri May 30 2014 Jens Petersen - 7.6.3-22 -- add ppc64le support patch from Debian by Colin Watson - (thanks to Jaromir Capik for Fedora ppc64le bootstrap) - -* Wed Jan 29 2014 Jens Petersen - 7.6.3-21 -- fix segfault on i686 when using ffi double-mapping for selinux (#907515) - see http://hackage.haskell.org/trac/ghc/ticket/7629 - (thanks Garrett Mitchener for patch committed upstream) - -* Wed Oct 30 2013 Jens Petersen - 7.6.3-20 -- enable debuginfo for C code bits (#989593) -- back to production build - -* Tue Oct 29 2013 Jens Petersen - 7.6.3-19 -- fix rts hang on 64bit bigendian archs (patch by Gustavo Luiz Duarte, #989593) -- generate and ship library doc index for ghc bundled libraries -- build with utf8 encoding (needed for verbose ghc output - and makes better sense anyway) -- change ghc-cabal to make library html docdirs unversioned -- bootstrap build - -* Sat Jul 27 2013 Jóhann B. Guðmundsson - 7.6.3-18 -- ghc-doc-index requires crontabs and mark cron file config noreplace - (http://fedoraproject.org/wiki/Packaging:CronFiles) - -* Wed Jul 24 2013 Jens Petersen - 7.6.3-17 -- silence warnings about unsupported llvm version (> 3.1) on ARM - -* Thu Jul 11 2013 Jens Petersen - 7.6.3-16 -- revert the executable stack patch since it didn't fully fix the problem - and yet changed the ghc library hash - -* Wed Jul 10 2013 Jens Petersen - 7.6.3-15 -- turn off executable stack flag in executables (#973512) - (thanks Edward Zhang for upstream patch and Dhiru Kholia for report) - -* Tue Jun 25 2013 Jens Petersen - 7.6.3-14 -- fix compilation with llvm-3.3 (#977652) - see http://hackage.haskell.org/trac/ghc/ticket/7996 - -* Thu Jun 20 2013 Jens Petersen - 7.6.3-13 -- production perf -O2 build -- see release notes: - http://www.haskell.org/ghc/docs/7.6.3/html/users_guide/release-7-6-1.html - http://www.haskell.org/ghc/docs/7.6.3/html/users_guide/release-7-6-2.html - http://www.haskell.org/ghc/docs/7.6.3/html/users_guide/release-7-6-3.html - -* Thu Jun 20 2013 Jens Petersen - 7.6.3-12 -- bootstrap 7.6.3 -- all library versions bumped except pretty -- ghc-7.4-add-support-for-ARM-hard-float-ABI-fixes-5914.patch, and - ghc-7.4-silence-gen_contents_index.patch are no longer needed -- build with ghc-rpm-macros-extra -- no longer filter type-level package from haddock index -- process obsoletes process-leksah -- do production build with BuildFlavour perf (#880135) - -* Tue Feb 5 2013 Jens Petersen - 7.4.2-11 -- ghclibdir should be owned at runtime by ghc-base instead of ghc-compiler - (thanks Michael Scherer, #907671) - -* Thu Jan 17 2013 Jens Petersen - 7.4.2-10 -- rebuild for F19 libffi soname bump - -* Wed Nov 21 2012 Jens Petersen - 7.4.2-9 -- fix permissions of ghc-doc-index and only run when root -- ghc-doc-index cronjob no longer looks at /etc/sysconfig/ghc-doc-index - -* Sat Nov 17 2012 Jens Petersen - 7.4.2-8 -- production 7.4.2 build - http://www.haskell.org/ghc/docs/7.4.2/html/users_guide/release-7-4-2.html - -* Sat Nov 17 2012 Jens Petersen - 7.4.2-7 -- 7.4.2 bootstrap -- update base and unix library versions -- ARM StgCRun patches not longer needed -- use Karel Gardas' ARM hardfloat patch committed upstream -- use _smp_mflags again -- disable Cabal building ghci lib files -- silence the doc re-indexing script and move the doc indexing cronjob - to a new ghc-doc-index subpackage (#870694) -- do not disable hscolour in build.mk -- drop the explicit hscolour BR -- without_hscolour should now be set by ghc-rpm-macros for bootstrapping - -* Thu Jul 19 2012 Fedora Release Engineering - 7.4.1-6 -- Rebuilt for https://fedoraproject.org/wiki/Fedora_18_Mass_Rebuild - -* Fri Jun 15 2012 Jens Petersen - 7.4.1-5 -- use ghc_lib_subpackage instead of ghc_binlib_package (ghc-rpm-macros 0.91) - -* Wed May 2 2012 Jens Petersen - 7.4.1-4 -- add ghc-wrapper-libffi-include.patch to workaround "missing libffi.h" - for prof compiling on secondary archs - -* Sat Apr 28 2012 Jens Petersen - 7.4.1-3 -- build with llvm-3.0 on ARM -- remove ARM from unregisterised_archs -- add 4 Debian ARM patches for armel and armhf (Iain Lane) - -* Wed Mar 21 2012 Jens Petersen - 7.4.1-2 -- full build - -* Wed Feb 15 2012 Jens Petersen - 7.4.1-1 -- update to new 7.4.1 major release - http://www.haskell.org/ghc/docs/7.4.1/html/users_guide/release-7-4-1.html -- all library versions bumped -- binary package replaces ghc-binary -- random library dropped -- new hoopl library -- deepseq is now included in ghc -- Cabal --enable-executable-dynamic patch is upstream -- add Cabal-fix-dynamic-exec-for-TH.patch -- sparc linking fix is upstream -- use Debian's system-libffi patch by Joachim Breitner -- setup ghc-deps.sh after ghc_version_override for bootstrapping -- drop ppc64 config, pthread and mmap patches -- do not set GhcUnregisterised explicitly -- add s390 and s390x to unregisterised_archs -- Cabal manual needs pandoc - -* Thu Jan 19 2012 Jens Petersen - 7.0.4-42 -- move ghc-ghc-devel from ghc-libraries to the ghc metapackage - -* Fri Jan 13 2012 Fedora Release Engineering - 7.0.4-41 -- Rebuilt for https://fedoraproject.org/wiki/Fedora_17_Mass_Rebuild - -* Mon Nov 14 2011 Jens Petersen - 7.0.4-40 -- do alternatives handling correctly (reported by Giam Teck Choon, #753661) - see https://fedoraproject.org/wiki/Packaging:Alternatives - -* Sat Nov 12 2011 Jens Petersen - 7.0.4-39 -- move ghc-doc and ghc-libs obsoletes -- add HaskellReport license also to the base and libraries subpackages - -* Thu Nov 10 2011 Jens Petersen - 7.0.4-38 -- the post and postun scripts are now for the compiler subpackage - -* Wed Nov 2 2011 Jens Petersen - 7.0.4-37 -- rename ghc-devel metapackage to ghc-libraries -- require ghc-rpm-macros-0.14 - -* Tue Nov 1 2011 Jens Petersen - 7.0.4-36 -- move compiler and tools to ghc-compiler -- the ghc base package is now a metapackage that installs all of ghc, - ie ghc-compiler and ghc-devel (#750317) -- drop ghc-doc provides - -* Fri Oct 28 2011 Jens Petersen - 7.0.4-35.1 -- rebuild against new gmp - -* Fri Oct 28 2011 Jens Petersen - 7.0.4-35 -- add HaskellReport license tag to some of the library subpackages - which contain some code from the Haskell Reports - -* Thu Oct 20 2011 Marcela Mašláňová - 7.0.4-34.1 -- rebuild with new gmp without compat lib - -* Thu Oct 20 2011 Jens Petersen - 7.0.4-34 -- setup ghc-deps.sh after ghc_version_override for bootstrapping - -* Tue Oct 18 2011 Jens Petersen - 7.0.4-33 -- add armv5tel (ported by Henrik Nordström) -- also use ghc-deps.sh when bootstrapping (ghc-rpm-macros-0.13.13) - -* Mon Oct 17 2011 Jens Petersen - 7.0.4-32 -- remove libffi_archs: not allowed to bundle libffi on any arch -- include the ghc (ghci) library in ghc-devel (Narasim) - -* Tue Oct 11 2011 Peter Schiffer - 7.0.4-31.1 -- rebuild with new gmp - -* Fri Sep 30 2011 Jens Petersen - 7.0.4-31 -- build with ghc-rpm-macros >= 0.13.11 to fix provides and obsoletes versions - in library devel subpackages - -* Thu Sep 29 2011 Jens Petersen - 7.0.4-30 -- no need to specify -lffi in build.mk (Henrik Nordström) - -* Wed Sep 28 2011 Jens Petersen - 7.0.4-29 -- port to armv7hl by Henrik Nordström (#741725) - -* Wed Sep 14 2011 Jens Petersen - 7.0.4-28 -- setup ghc-deps.sh when not bootstrapping! - -* Wed Sep 14 2011 Jens Petersen - 7.0.4-27 -- setup dependency generation with ghc-deps.sh since it was moved to - ghc_lib_install in ghc-rpm-macros - -* Fri Jun 17 2011 Jens Petersen - 7.0.4-26 -- BR same ghc version unless ghc_bootstrapping defined -- add libffi_archs -- drop the quick build profile -- put dyn before p in GhcLibWays -- explain new bootstrapping mode using ghc_bootstrap (ghc-rpm-macros-0.13.5) - -* Thu Jun 16 2011 Jens Petersen - 7.0.4-25 -- update to 7.0.4 bugfix release - http://haskell.org/ghc/docs/7.0.4/html/users_guide/release-7-0-4.html -- strip static again (upstream #5004 fixed) -- Cabal updated to 1.10.2.0 -- re-enable testsuite -- update summary and description - -* Tue Jun 14 2011 Jens Petersen - 7.0.2-24 -- finally change from ExclusiveArch to ExcludeArch to target more archs - -* Sat May 21 2011 Jens Petersen - 7.0.2-23 -- obsolete dph libraries and feldspar-language - -* Mon May 16 2011 Jens Petersen - 7.0.2-22 -- merge prof subpackages into the devel subpackages with ghc-rpm-macros-0.13 - -* Wed May 11 2011 Jens Petersen - 7.0.2-21 -- configure with /usr/bin/gcc to help bootstrapping to new archs - (otherwise ccache tends to get hardcoded as gcc, which not in koji) -- posttrans scriplet for ghc_pkg_recache is redundant - -* Mon May 9 2011 Jens Petersen - 7.0.2-20 -- make devel and prof meta packages require libs with release -- make ghc-*-devel subpackages require ghc with release - -* Wed May 04 2011 Jiri Skala - 7.0.2-19.1 -- fixes path to gcc on ppc64 arch - -* Tue Apr 26 2011 Jens Petersen - 7.0.2-19 -- add upstream ghc-powerpc-linker-mmap.patch for ppc64 (Jiri Skala) - -* Thu Apr 21 2011 Jiri Skala - 7.0.2-18 -- bootstrap to ppc64 - -* Fri Apr 1 2011 Jens Petersen - 7.0.2-17 -- rebuild against ghc-rpm-macros-0.11.14 to provide ghc-*-doc - -* Fri Apr 1 2011 Jens Petersen - 7.0.2-16 -- provides ghc-doc again: it is still a buildrequires for libraries -- ghc-prof now requires ghc-devel -- ghc-devel now requires ghc explicitly - -* Wed Mar 30 2011 Jens Petersen - 7.0.2-15 -- do not strip static libs since it breaks ghci-7.0.2 loading libHSghc.a - (see http://hackage.haskell.org/trac/ghc/ticket/5004) -- no longer provide ghc-doc -- no longer obsolete old haddock - -* Tue Mar 29 2011 Jens Petersen - 7.0.2-14 -- fix back missing LICENSE files in library subpackages -- drop ghc_reindex_haddock from install script - -* Thu Mar 10 2011 Jens Petersen - 7.0.2-13 -- rebuild against 7.0.2 - -* Wed Mar 9 2011 Jens Petersen - 7.0.2-12 -- update to 7.0.2 release -- move bin-package-db into ghc-ghc -- disable broken testsuite - -* Wed Feb 23 2011 Fabio M. Di Nitto 7.0.1-11 -- enable build on sparcv9 -- add ghc-fix-linking-on-sparc.patch to fix ld being called - at the same time with --relax and -r. The two options conflict - on sparc. -- bump BuildRequires on ghc-rpm-macros to >= 0.11.10 that guarantees - a correct build on secondary architectures. - -* Sun Feb 13 2011 Jens Petersen -- without_shared renamed to ghc_without_shared - -* Thu Feb 10 2011 Jens Petersen - 7.0.1-10 -- rebuild - -* Thu Feb 10 2011 Jens Petersen - 7.0.1-9 -- fix without_shared build (thanks Adrian Reber) -- disable system libffi for secondary archs -- temporarily disable ghc-*-devel BRs for ppc - -* Tue Feb 08 2011 Fedora Release Engineering - 7.0.1-8 -- Rebuilt for https://fedoraproject.org/wiki/Fedora_15_Mass_Rebuild - -* Mon Jan 31 2011 Jens Petersen - 7.0.1-7 -- include LICENSE files in the shared lib subpackages - -* Sat Jan 22 2011 Jens Petersen - 7.0.1-6 -- patch Cabal to add configure option --enable-executable-dynamic -- exclude huge ghc API library from devel and prof metapackages - -* Thu Jan 13 2011 Jens Petersen - 7.0.1-5 -- fix no doc and no manual builds - -* Thu Jan 13 2011 Jens Petersen - 7.0.1-4 -- add BRs for various subpackaged ghc libraries needed to build ghc -- condition rts .so libraries for non-shared builds - -* Thu Dec 30 2010 Jens Petersen - 7.0.1-3 -- subpackage all the libraries with ghc-rpm-macros-0.11.1 -- put rts, integer-gmp and ghc-prim in base, and ghc-binary in bin-package-db -- drop the libs mega-subpackage -- prof now a meta-package for backward compatibility -- add devel meta-subpackage to easily install all ghc libraries -- store doc cronjob package cache file under /var (#664850) -- drop old extralibs bcond -- no longer need to define or clean buildroot -- ghc base package now requires ghc-base-devel -- drop ghc-time obsoletes - -* Wed Nov 24 2010 Jens Petersen - 7.0.1-2 -- require libffi-devel - -* Tue Nov 16 2010 Jens Petersen - 7.0.1-1 -- update to 7.0.1 release -- turn on system libffi now - -* Mon Nov 8 2010 Jens Petersen - 6.12.3-9 -- disable the libffi changes for now since they break libHSffi*.so - -* Thu Nov 4 2010 Jens Petersen - 6.12.3-8 -- add a cronjob for doc indexing -- disable gen_contents_index when not run with --batch for cron -- use system libffi with ghc-use-system-libffi.patch from debian -- add bcond for system libffi - -* Thu Nov 4 2010 Jens Petersen - 6.12.3-7 -- skip huge type-level docs from haddock re-indexing (#649228) - -* Thu Sep 30 2010 Jens Petersen - 6.12.3-6 -- move gtk2hs obsoletes to ghc-glib and ghc-gtk -- drop happy buildrequires -- smp build with max 4 cpus - -* Fri Jul 30 2010 Jens Petersen - 6.12.3-5 -- obsolete old gtk2hs packages for smooth upgrades - -* Thu Jul 15 2010 Jens Petersen - 6.12.3-4 -- merge ghc-doc into base package -- obsolete ghc-time and ghc-ghc-doc (ghc-rpm-macros-0.8.0) -- note that ghc-6.12.3 is part of haskell-platform-2010.2.0.0 - -* Thu Jun 24 2010 Jens Petersen - 6.12.3-3 -- drop the broken summary and description args to the ghc-ghc package - and use ghc-rpm-macros-0.6.1 - -* Wed Jun 23 2010 Jens Petersen - 6.12.3-2 -- strip all dynlinked files not just shared objects (ghc-rpm-macros-0.5.9) - -* Mon Jun 14 2010 Jens Petersen - 6.12.3-1 -- 6.12.3 release: - http://darcs.haskell.org/download/docs/6.12.3/html/users_guide/release-6-12-3.html -- build with hscolour -- use ghc-rpm-macro-0.5.8 for ghc_strip_shared macro - -* Fri May 28 2010 Jens Petersen - 6.12.2.20100521-1 -- 6.12.3 rc1 -- ghost package.cache -- drop ghc-utf8-string obsoletes since it is no longer provided -- run testsuite fast -- fix description and summary of ghc internal library (John Obbele) - -* Fri Apr 23 2010 Jens Petersen - 6.12.2-1 -- update to 6.12.2 -- add testsuite with bcond, run it in check section, and BR python - -* Mon Apr 12 2010 Jens Petersen - 6.12.1-6 -- ghc-6.12.1 is part of haskell-platform-2010.1.0.0 -- drop old ghc682, ghc681, haddock09 obsoletes -- drop haddock_version and no longer provide haddock explicitly -- update ghc-rpm-macros BR to 0.5.6 for ghc_pkg_recache - -* Mon Jan 11 2010 Jens Petersen - 6.12.1-5 -- drop ghc-6.12.1-no-filter-libs.patch and extras packages again -- filter ghc-ghc-prof files from ghc-prof -- ghc-mtl package was added to fedora - -* Mon Jan 11 2010 Jens Petersen - 6.12.1-4 -- ghc-rpm-macros-0.5.4 fixes wrong version requires between lib subpackages - -* Mon Jan 11 2010 Jens Petersen - 6.12.1-3 -- ghc-rpm-macros-0.5.2 fixes broken pkg_name requires for lib subpackages - -* Tue Dec 22 2009 Jens Petersen - 6.12.1-2 -- include haskeline, mtl, and terminfo for now with - ghc-6.12.1-no-filter-libs.patch -- use ghc_binlibpackage, grep -v and ghc_gen_filelists to generate - the library subpackages (ghc-rpm-macros-0.5.1) -- always set GhcLibWays (Lorenzo Villani) -- use ghcdocbasedir to revert html doc path to upstream's html/ for consistency - -* Wed Dec 16 2009 Jens Petersen - 6.12.1-1 -- pre became 6.12.1 final -- exclude ghc .conf file from package.conf.d in base package -- use ghc_reindex_haddock -- add scripts for ghc-ghc-devel and ghc-ghc-doc -- add doc bcond -- add ghc-6.12.1-gen_contents_index-haddock-path.patch to adjust haddock path - since we removed html/ from libraries path -- require ghc-rpm-macros-0.3.1 and use ghc_version_override - -* Sat Dec 12 2009 Jens Petersen - 6.12.1-0.2 -- remove redundant mingw and perl from ghc-tarballs/ -- fix exclusion of ghc internals lib from base packages with -mindepth -- rename the final file lists to PKGNAME.files for clarity - -* Fri Dec 11 2009 Jens Petersen - 6.12.1-0.1 -- update to ghc-6.12.1-pre -- separate bcond options into enabled and disabled for clarity -- only enable shared for intel x86 archs (Lorenzo Villani) -- add quick build profile (Lorenzo Villani) -- remove package_debugging hack (use "make install-short") -- drop sed BR (Lorenzo Villani) -- put all build.mk config into one cat block (Lorenzo Villani) -- export CFLAGS to configure (Lorenzo Villani) -- add dynamic linking test to check section (thanks Lorenzo Villani) -- remove old ghc66 obsoletes -- subpackage huge ghc internals library (thanks Lorenzo Villani) - - BR ghc-rpm-macros >= 0.3.0 -- move html docs to docdir/ghc from html subdir (Lorenzo Villani) -- disable smp build for now: broken for 8 cpus at least - -* Wed Nov 18 2009 Jens Petersen - 6.12.0.20091121-1 -- update to 6.12.1 rc2 -- build shared libs, yay! and package in standalone libs subpackage -- add bcond for manual and extralibs -- reenable ppc secondary arch -- don't provide ghc-haddock-* -- remove obsolete post requires policycoreutils -- add vanilla v to GhcLibWays when building without prof -- handle without hscolour -- can't smp make currently -- lots of filelist fixes for handling shared libs -- run ghc-pkg recache posttrans -- no need to install gen_contents_index by hand -- manpage is back - -* Thu Nov 12 2009 Bryan O'Sullivan - 6.12.0.20091010-8 -- comprehensive attempts at packaging fixes - -* Thu Nov 12 2009 Bryan O'Sullivan - 6.12.0.20091010-7 -- fix package.conf stuff - -* Thu Nov 12 2009 Bryan O'Sullivan - 6.12.0.20091010-6 -- give up trying to install man pages - -* Thu Nov 12 2009 Bryan O'Sullivan - 6.12.0.20091010-5 -- try to install man pages - -* Thu Nov 12 2009 Bryan O'Sullivan - 6.12.0.20091010-3 -- fix %%check - -* Sun Oct 11 2009 Bryan O'Sullivan - 6.12.0.20091010-2 -- disable ppc for now (seems unsupported) -- buildreq ncurses-devel - -* Sun Oct 11 2009 Bryan O'Sullivan - 6.12.0.20091010-1 -- Update to 6.12 RC 1 - -* Thu Oct 1 2009 Jens Petersen -- selinux file context no longer needed in post script -- (for ghc-6.12-shared) drop ld.so.conf.d files - -* Fri Jul 24 2009 Fedora Release Engineering - 6.10.4-2 -- Rebuilt for https://fedoraproject.org/wiki/Fedora_12_Mass_Rebuild - -* Tue Jul 21 2009 Bryan O'Sullivan - 6.10.4-1 -- update to 6.10.4 - -* Sat May 30 2009 Jens Petersen - 6.10.3-3 -- add haddock_version and use it to obsolete haddock and ghc-haddock-* - -* Fri May 22 2009 Jens Petersen - 6.10.3-2 -- update haddock provides and obsoletes -- drop ghc-mk-pkg-install-inplace.patch: no longer needed with new 6.11 buildsys -- add bcond for extralibs -- rename doc bcond to manual - -* Wed May 13 2009 Jens Petersen - 6.10.3-1 -- update to 6.10.3 -- haskline replaces editline, so it is no longer needed to build -- macros.ghc moved to ghc-rpm-macros package -- fix handling of hscolor files in filelist generation - -* Tue Apr 28 2009 Jens Petersen - 6.10.2-4 -- add experimental bcond hscolour -- add experimental support for building shared libraries (for ghc-6.11) - - add libs subpackage for shared libraries - - create a ld.conf.d file for libghc*.so - - BR libffi-devel -- drop redundant setting of GhcLibWays in build.mk for no prof -- drop redundant setting of HADDOCK_DOCS -- simplify filelist names -- add a check section based on tests from debian's package -- be more careful about doc files in filelist - -* Fri Apr 24 2009 Jens Petersen - 6.10.2-3 -- define ghc_version in macros.ghc in place of ghcrequires -- drop ghc-requires script for now - -* Sun Apr 19 2009 Jens Petersen - 6.10.2-2 -- add ghc-requires rpm script to generate ghc version dependencies - (thanks to Till Maas) -- update macros.ghc: - - add %%ghcrequires to call above script - - pkg_libdir and pkg_docdir obsoleted in packages and replaced - by ghcpkgdir and ghcdocdir inside macros.ghc - - make filelist also for docs - -* Wed Apr 08 2009 Bryan O'Sullivan - 6.10.2-1 -- Update to 6.10.2 - -* Fri Feb 27 2009 Jens Petersen - 6.10.1-13 -- ok let's stick with ExclusiveArch for brevity - -* Fri Feb 27 2009 Jens Petersen - 6.10.1-12 -- drop ghc_archs since it breaks koji -- fix missing -devel in ghc_gen_filelists -- change from ExclusiveArch to ExcludeArch ppc64 since alpha was bootstrapped - by oliver - -* Wed Feb 25 2009 Jens Petersen - 6.10.1-11 -- use %%ix86 for change from i386 to i586 in rawhide -- add ghc_archs macro in macros.ghc for other packages -- obsolete haddock09 -- use %%global instead of %%define -- use bcond for doc and prof -- rename ghc_gen_filelists lib filelist to -devel.files - -* Tue Feb 24 2009 Fedora Release Engineering - 6.10.1-10 -- Rebuilt for https://fedoraproject.org/wiki/Fedora_11_Mass_Rebuild - -* Fri Feb 13 2009 Jens Petersen - 6.10.1-9 -- require and buildrequire libedit-devel > 2.11-2 -- protect ghc_register_pkg and ghc_unregister_pkg - -* Fri Jan 23 2009 Jens Petersen - 6.10.1-8 -- fix to libedit means can drop ncurses-devel BR workaround (#481252) - -* Mon Jan 19 2009 Jens Petersen - 6.10.1-7 -- buildrequire ncurses-devel to fix build of missing editline package needed - for ghci line-editing (#478466) -- move spec templates to cabal2spec package for easy updating -- provide correct haddock version - -* Mon Dec 1 2008 Jens Petersen - 6.10.1-6 -- update macros.ghc to latest proposed revised packaging guidelines: - - use runghc - - drop trivial cabal_build and cabal_haddock macros - - ghc_register_pkg and ghc_unregister_pkg replace ghc_preinst_script, - ghc_postinst_script, ghc_preun_script, and ghc_postun_script -- library templates prof subpackage requires main library again -- make cabal2spec work on .cabal files too, and - read and check name and version directly from .cabal file -- ghc-prof does not need to own libraries dirs owned by main package - -* Tue Nov 25 2008 Jens Petersen - 6.10.1-5 -- add cabal2spec and template files for easy cabal hackage packaging -- simplify script macros: make ghc_preinst_script and ghc_postun_script no-ops - and ghc_preun_script only unregister for uninstall - -* Tue Nov 11 2008 Jens Petersen - 6.10.1-4 -- fix broken urls to haddock docs created by gen_contents_index script -- avoid haddock errors when upgrading by making doc post script posttrans - -* Wed Nov 05 2008 Bryan O'Sullivan - 6.10.1-3 -- libraries/prologue.txt should not have been ghosted - -* Tue Nov 04 2008 Bryan O'Sullivan - 6.10.1-2 -- Fix a minor packaging glitch - -* Tue Nov 04 2008 Bryan O'Sullivan - 6.10.1-1 -- Update to 6.10.1 - -* Thu Oct 23 2008 Jens Petersen - 6.10.0.20081007-9 -- remove redundant --haddockdir from cabal_configure -- actually ghc-pkg no longer seems to create package.conf.old backups -- include LICENSE in doc - -* Thu Oct 23 2008 Jens Petersen - 6.10.0.20081007-8 -- need to create ghost package.conf.old for ghc-6.10 - -* Thu Oct 23 2008 Jens Petersen - 6.10.0.20081007-7 -- use gen_contents_index to re-index haddock -- add %%pkg_docdir to cabal_configure -- requires(post) ghc for haddock for doc -- improve doc file lists -- no longer need to create ghost package.conf.old -- remove or rename alternatives files more consistently - -* Tue Oct 14 2008 Bryan O'Sullivan - 6.10.0.20081007-6 -- Update macros to install html and haddock bits in the right places - -* Tue Oct 14 2008 Bryan O'Sullivan - 6.10.0.20081007-5 -- Don't use a macro to update the docs for the main doc package - -* Tue Oct 14 2008 Bryan O'Sullivan - 6.10.0.20081007-4 -- Add ghc_haddock_reindex macro -- Generate haddock index after installing ghc-doc package - -* Mon Oct 13 2008 Jens Petersen - 6.10.0.20081007-3 -- provide haddock = 2.2.2 -- add selinux file context for unconfined_execmem following darcs package -- post requires policycoreutils - -* Sun Oct 12 2008 Bryan O'Sullivan - 6.10.0.20081007-2.fc10 -- Use libedit in preference to readline, for BSD license consistency -- With haddock bundled now, obsolete standalone versions (but not haddock09) -- Drop obsolete freeglut-devel, openal-devel, and haddock09 dependencies - -* Sun Oct 12 2008 Bryan O'Sullivan - 6.10.0.20081007-1.fc10 -- Update to 6.10.1 release candidate 1 - -* Wed Oct 1 2008 Bryan O'Sullivan - 6.10.0.20080921-1.fc10 -- Drop unneeded haddock patch -- Rename hsc2hs to hsc2hs-ghc so the alternatives symlink to it will work - -* Wed Sep 24 2008 Jens Petersen - 6.8.3-5 -- bring back including haddock-generated lib docs, now under docdir/ghc -- fix macros.ghc filepath (#460304) -- spec file cleanups: -- fix the source urls back -- drop requires chkconfig -- do not override __spec_install_post -- setup docs building in build.mk -- no longer need to remove network/include/Typeable.h -- install binaries under libdir not libexec -- remove hsc2hs and runhaskell binaries since they are alternatives - -* Wed Sep 17 2008 Jens Petersen - 6.8.3-4 -- add macros.ghc for new Haskell Packaging Guidelines (#460304) - -* Wed Jun 18 2008 Bryan O'Sullivan - 6.8.3-3 -- Add symlinks from _libdir, where ghc looks, to _libexecdir -- Patch libraries/gen_contents_index to use haddock-0.9 - -* Wed Jun 18 2008 Bryan O'Sullivan - 6.8.3-2 -- Remove unnecessary dependency on alex - -* Wed Jun 18 2008 Bryan O'Sullivan - 6.8.3-1 -- Upgrade to 6.8.3 -- Drop the ghc682-style naming scheme, obsolete those packages -- Manually strip binaries - -* Tue Apr 8 2008 Jens Petersen - 6.8.2-10 -- another rebuild attempt - -* Thu Feb 14 2008 Jens Petersen - 6.8.2-9 -- remove unrecognized --docdir and --htmldir from configure -- drop old buildrequires on libX11-devel and libXt-devel -- rebuild with gcc43 - -* Sun Jan 06 2008 Bryan O'Sullivan - 6.8.2-7 -- More attempts to fix docdir - -* Sun Jan 06 2008 Bryan O'Sullivan - 6.8.2-6 -- Fix docdir - -* Wed Dec 12 2007 Bryan O'Sullivan - 6.8.2-1 -- Update to 6.8.2 - -* Fri Nov 23 2007 Bryan O'Sullivan - 6.8.1-2 -- Exclude alpha - -* Thu Nov 8 2007 Bryan O'Sullivan - 6.8.1-2 -- Drop bit-rotted attempts at making package relocatable - -* Sun Nov 4 2007 Michel Salim - 6.8.1-1 -- Update to 6.8.1 - -* Sat Sep 29 2007 Bryan O'Sullivan - 6.8.0.20070928-2 -- add happy to BuildRequires - -* Sat Sep 29 2007 Bryan O'Sullivan - 6.8.0.20070928-1 -- prepare for GHC 6.8.1 by building a release candidate snapshot - -* Thu May 10 2007 Bryan O'Sullivan - 6.6.1-3 -- install man page for ghc - -* Thu May 10 2007 Bryan O'Sullivan - 6.6.1-2 -- exclude ppc64 for now, due to lack of time to bootstrap - -* Wed May 9 2007 Bryan O'Sullivan - 6.6.1-1 -- update to 6.6.1 release - -* Mon Jan 22 2007 Jens Petersen - 6.6-2 -- remove truncated duplicate Typeable.h header in network package - (Bryan O'Sullivan, #222865) - -* Fri Nov 3 2006 Jens Petersen - 6.6-1 -- update to 6.6 release -- buildrequire haddock >= 0.8 -- fix summary of ghcver package (Michel Salim, #209574) - -* Thu Sep 28 2006 Jens Petersen - 6.4.2-4 -- turn on docs generation again - -* Mon Sep 25 2006 Jens Petersen - 6.4.2-3.fc6 -- ghost package.conf.old (Gérard Milmeister) -- set unconfined_execmem_exec_t context on executables with ghc rts (#195821) -- turn off building docs until haddock is back - -* Sat Apr 29 2006 Jens Petersen - 6.4.2-2.fc6 -- buildrequire libXt-devel so that the X11 package and deps get built - (Garrett Mitchener, #190201) - -* Thu Apr 20 2006 Jens Petersen - 6.4.2-1.fc6 -- update to 6.4.2 release - -* Thu Mar 2 2006 Jens Petersen - 6.4.1-3.fc5 -- buildrequire libX11-devel instead of xorg-x11-devel (Kevin Fenzi, #181024) -- make ghc-doc require ghc (Michel Salim, #180449) - -* Tue Oct 11 2005 Jens Petersen - 6.4.1-2.fc5 -- turn on build_doc since haddock is now in Extras -- no longer specify ghc version to build with (Ville Skyttä, #170176) - -* Tue Sep 20 2005 Jens Petersen - 6.4.1-1.fc5 -- 6.4.1 release - - the following patches are now upstream: ghc-6.4-powerpc.patch, - rts-GCCompact.h-x86_64.patch, ghc-6.4-dsforeign-x86_64-1097471.patch, - ghc-6.4-rts-adjustor-x86_64-1097471.patch - - builds with gcc4 so drop %%_with_gcc32 - - x86_64 build restrictions (no ghci and split objects) no longer apply - -* Tue May 31 2005 Jens Petersen -- add %%dist to release - -* Thu May 12 2005 Jens Petersen - 6.4-8 -- initial import into Fedora Extras - -* Thu May 12 2005 Jens Petersen -- add build_prof and build_doc switches for -doc and -prof subpackages -- add _with_gcc32 switch since ghc-6.4 doesn't build with gcc-4.0 - -* Wed May 11 2005 Jens Petersen - 6.4-7 -- make package relocatable (ghc#1084122) - - add post install scripts to replace prefix in driver scripts -- buildrequire libxslt and docbook-style-xsl instead of docbook-utils and flex - -* Fri May 6 2005 Jens Petersen - 6.4-6 -- add ghc-6.4-dsforeign-x86_64-1097471.patch and - ghc-6.4-rts-adjustor-x86_64-1097471.patch from trunk to hopefully fix - ffi support on x86_64 (Simon Marlow, ghc#1097471) -- use XMLDocWays instead of SGMLDocWays to build documentation fully - -* Mon May 2 2005 Jens Petersen - 6.4-5 -- add rts-GCCompact.h-x86_64.patch to fix GC issue on x86_64 (Simon Marlow) - -* Thu Mar 17 2005 Jens Petersen - 6.4-4 -- add ghc-6.4-powerpc.patch (Ryan Lortie) -- disable building interpreter rather than install and delete on x86_64 - -* Wed Mar 16 2005 Jens Petersen - 6.4-3 -- make ghc require ghcver of same ver-rel -- on x86_64 remove ghci for now since it doesn't work and all .o files - -* Tue Mar 15 2005 Jens Petersen - 6.4-2 -- ghc requires ghcver (Amanda Clare) - -* Sat Mar 12 2005 Jens Petersen - 6.4-1 -- 6.4 release - - x86_64 build no longer unregisterised -- use sed instead of perl to tidy filelists -- buildrequire ghc64 instead of ghc-6.4 -- no epoch for ghc64-prof's ghc64 requirement -- install docs directly in docdir - -* Fri Jan 21 2005 Jens Petersen - 6.2.2-2 -- add x86_64 port - - build unregistered and without splitobjs - - specify libdir to configure and install -- rename ghc-prof to ghcXYZ-prof, which obsoletes ghc-prof - -* Mon Dec 6 2004 Jens Petersen - 6.2.2-1 -- move ghc requires to ghcXYZ - -* Wed Nov 24 2004 Jens Petersen - 6.2.2-0.fdr.1 -- ghc622 - - provide ghc = %%version -- require gcc, gmp-devel and readline-devel - -* Fri Oct 15 2004 Gerard Milmeister - 6.2.2-0.fdr.1 -- New Version 6.2.2 - -* Mon Mar 22 2004 Gerard Milmeister - 6.2.1-0.fdr.1 -- New Version 6.2.1 - -* Tue Dec 16 2003 Gerard Milmeister - 6.2-0.fdr.1 -- New Version 6.2 - -* Tue Dec 16 2003 Gerard Milmeister - 6.0.1-0.fdr.3 -- A few minor specfile tweaks - -* Mon Dec 15 2003 Gerard Milmeister - 6.0.1-0.fdr.2 -- Different file list generation - -* Mon Oct 20 2003 Gerard Milmeister - 6.0.1-0.fdr.1 -- First Fedora release -- Added generated html docs, so that haddock is not needed - -* Wed Sep 26 2001 Manuel Chakravarty -- small changes for 5.04 - -* Wed Sep 26 2001 Manuel Chakravarty -- split documentation off into a separate package -- adapt to new docbook setup in RH7.1 - -* Mon Apr 16 2001 Manuel Chakravarty -- revised for 5.00 -- also runs autoconf automagically if no ./configure found - -* Thu Jun 22 2000 Sven Panne -- removed explicit usage of hslibs/docs, it belongs to ghc/docs/set - -* Sun Apr 23 2000 Manuel Chakravarty -- revised for ghc 4.07; added suggestions from Pixel -- added profiling package - -* Tue Dec 7 1999 Manuel Chakravarty -- version for use from CVS - -* Thu Sep 16 1999 Manuel Chakravarty -- modified for GHC 4.04, patchlevel 1 (no more 62 tuple stuff); minimises use - of patch files - instead emits a build.mk on-the-fly - -* Sat Jul 31 1999 Manuel Chakravarty -- modified for GHC 4.04 - -* Wed Jun 30 1999 Manuel Chakravarty -- some more improvements from vbzoli - -* Fri Feb 26 1999 Manuel Chakravarty -- modified for GHC 4.02 - -* Thu Dec 24 1998 Zoltan Vorosbaranyi -- added BuildRoot -- files located in /usr/local/bin, /usr/local/lib moved to /usr/bin, /usr/lib - -* Tue Jul 28 1998 Manuel Chakravarty -- original version