diff --git a/overlays/bootstrap.nix b/overlays/bootstrap.nix index 3ee1c136a8..2946725488 100644 --- a/overlays/bootstrap.nix +++ b/overlays/bootstrap.nix @@ -346,6 +346,12 @@ in { ++ onWasm (until "9.13" ./patches/ghc/ghc-9.12-wasm-shared-libs.patch) ++ onWasm (until "9.13" ./patches/ghc/ghc-9.12-wasm-keep-cafs.patch) + + # See https://github.com/IntersectMBO/plutus/issues/7415#issuecomment-3531989244 + ++ fromUntil "9.6" "9.9" ./patches/ghc/ghc-profiling-fix.patch + + # See https://gitlab.haskell.org/ghc/ghc/-/merge_requests/15096 + ++ fromUntil "9.6" "9.13" ./patches/ghc/ghc-16bit-elf-section-header-overflow.patch ; in ({ ghc8107 = traceWarnOld "8.10" (final.callPackage ../compiler/ghc { diff --git a/overlays/patches/ghc/ghc-16bit-elf-section-header-overflow.patch b/overlays/patches/ghc/ghc-16bit-elf-section-header-overflow.patch new file mode 100644 index 0000000000..812a78988b --- /dev/null +++ b/overlays/patches/ghc/ghc-16bit-elf-section-header-overflow.patch @@ -0,0 +1,34 @@ +From e90e136c16ef10fc47d339cf8964255a5131c9c9 Mon Sep 17 00:00:00 2001 +From: Luite Stegeman +Date: Sat, 22 Nov 2025 15:05:37 +0100 +Subject: [PATCH] rts: Handle 16-bit overflow of ELF section header string + table + +If the section header string table is stored in a section greater +than 65535, the 16-bit value e_shstrndx in the ELF header does not +contain the section number, but rather an overflow value SHN_XINDEX +indicating that we need to look elsewhere. + +This fixes the linker by not using e_shstrndx directly but calling +elf_shstrndx, which correctly handles the overflow value. + +Fixes #26603 +--- + rts/linker/Elf.c | 2 +- + 1 file changed, 1 insertion(+), 1 deletion(-) + +diff --git a/rts/linker/Elf.c b/rts/linker/Elf.c +index 85a56c120d49..0314abb0c68c 100644 +--- a/rts/linker/Elf.c ++++ b/rts/linker/Elf.c +@@ -205,7 +205,7 @@ ocInit_ELF(ObjectCode * oc) + oc->info->sectionHeader = (Elf_Shdr *) ((uint8_t*)oc->image + + oc->info->elfHeader->e_shoff); + oc->info->sectionHeaderStrtab = (char*)((uint8_t*)oc->image + +- oc->info->sectionHeader[oc->info->elfHeader->e_shstrndx].sh_offset); ++ oc->info->sectionHeader[elf_shstrndx(oc->info->elfHeader)].sh_offset); + + oc->n_sections = elf_shnum(oc->info->elfHeader); + +-- +GitLab \ No newline at end of file diff --git a/overlays/patches/ghc/ghc-profiling-fix.patch b/overlays/patches/ghc/ghc-profiling-fix.patch new file mode 100644 index 0000000000..f2d8e1c54e --- /dev/null +++ b/overlays/patches/ghc/ghc-profiling-fix.patch @@ -0,0 +1,46 @@ +diff --git a/compiler/GHC/Core/Utils.hs b/compiler/GHC/Core/Utils.hs +index 0453fb93af..84d2d9cfe5 100644 +--- a/compiler/GHC/Core/Utils.hs ++++ b/compiler/GHC/Core/Utils.hs +@@ -79,7 +79,7 @@ import GHC.Core.Reduction + import GHC.Core.TyCon + import GHC.Core.Multiplicity + +-import GHC.Builtin.Names ( makeStaticName, unsafeEqualityProofIdKey ) ++import GHC.Builtin.Names ( makeStaticName, unsafeEqualityProofIdKey, unsafeReflDataConKey ) + import GHC.Builtin.PrimOps + + import GHC.Types.Var +@@ -328,6 +328,10 @@ mkTick t orig_expr = mkTick' id id orig_expr + -> CoreExpr + mkTick' top rest expr = case expr of + ++ Case scrut bndr ty alts@[Alt ac abs _rhs] ++ | Just rhs <- isUnsafeEqualityCase scrut bndr alts ++ -> top $ mkTick' (\e -> Case scrut bndr ty [Alt ac abs e]) rest rhs ++ + -- Cost centre ticks should never be reordered relative to each + -- other. Therefore we can stop whenever two collide. + Tick t2 e +@@ -2676,3 +2680,21 @@ isUnsafeEqualityProof e + = v `hasKey` unsafeEqualityProofIdKey + | otherwise + = False ++ ++isUnsafeEqualityCase :: CoreExpr -> Id -> [CoreAlt] -> Maybe CoreExpr ++-- See (U3) and (U4) in ++-- Note [Implementing unsafeCoerce] in base:Unsafe.Coerce ++isUnsafeEqualityCase scrut bndr alts ++ | [Alt ac _ rhs] <- alts ++ , DataAlt dc <- ac ++ , dc `hasKey` unsafeReflDataConKey ++ , isDeadBinder bndr ++ -- We can only discard the case if the case-binder is dead ++ -- It usually is, but see #18227 ++ , Var v `App` _ `App` _ `App` _ <- scrut ++ , v `hasKey` unsafeEqualityProofIdKey ++ -- Check that the scrutinee really is unsafeEqualityProof ++ -- and not, say, error ++ = Just rhs ++ | otherwise ++ = Nothing