Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC
Commits:
2433e91d by Cheng Shao at 2026-01-09T20:24:43-05:00
compiler: change sectionProtection to take SectionType argument
This commit changes `sectionProtection` to only take `SectionType`
argument instead of whole `Section`, since it doesn't need the Cmm
section content anyway, and it can then be called in parts of NCG
where we only have a `SectionType` in scope.
- - - - -
e5926fbe by Cheng Shao at 2026-01-09T20:24:43-05:00
compiler: change isInitOrFiniSection to take SectionType argument
This commit changes `isInitOrFiniSection` to only take `SectionType`
argument instead of whole `Section`, since it doesn't need the Cmm
section content anyway, and it can then be called in parts of NCG
where we only have a `SectionType` in scope. Also marks it as
exported.
- - - - -
244d57d7 by Cheng Shao at 2026-01-09T20:24:43-05:00
compiler: fix split sections on windows
This patch fixes split sections on windows by emitting the right
COMDAT section header in NCG, see added comment for more explanation.
Fix #26696 #26494.
-------------------------
Metric Decrease:
LargeRecord
T9675
size_hello_artifact
size_hello_artifact_gzip
size_hello_unicode
size_hello_unicode_gzip
Metric Increase:
T13035
-------------------------
Co-authored-by: Codex
- - - - -
8 changed files:
- compiler/GHC/Cmm.hs
- compiler/GHC/Cmm/InitFini.hs
- compiler/GHC/CmmToAsm/AArch64/Ppr.hs
- compiler/GHC/CmmToAsm/Ppr.hs
- compiler/GHC/CmmToAsm/Wasm/FromCmm.hs
- compiler/GHC/CmmToAsm/X86/Ppr.hs
- compiler/GHC/CmmToC.hs
- compiler/GHC/CmmToLlvm/Data.hs
Changes:
=====================================
compiler/GHC/Cmm.hs
=====================================
@@ -278,8 +278,8 @@ data SectionProtection
deriving (Eq)
-- | Should a data in this section be considered constant at runtime
-sectionProtection :: Section -> SectionProtection
-sectionProtection (Section t _) = case t of
+sectionProtection :: SectionType -> SectionProtection
+sectionProtection t = case t of
Text -> ReadOnlySection
ReadOnlyData -> ReadOnlySection
RelocatableReadOnlyData -> WriteProtectedSection
=====================================
compiler/GHC/Cmm/InitFini.hs
=====================================
@@ -2,6 +2,7 @@
module GHC.Cmm.InitFini
( InitOrFini(..)
, isInitOrFiniArray
+ , isInitOrFiniSection
) where
import GHC.Prelude
@@ -63,8 +64,8 @@ finalizer CmmDecl will be emitted per module.
data InitOrFini = IsInitArray | IsFiniArray
isInitOrFiniArray :: RawCmmDecl -> Maybe (InitOrFini, [CLabel])
-isInitOrFiniArray (CmmData sect (CmmStaticsRaw _ lits))
- | Just initOrFini <- isInitOrFiniSection sect
+isInitOrFiniArray (CmmData (Section t _) (CmmStaticsRaw _ lits))
+ | Just initOrFini <- isInitOrFiniSection t
= Just (initOrFini, map get_label lits)
where
get_label :: CmmStatic -> CLabel
@@ -72,7 +73,7 @@ isInitOrFiniArray (CmmData sect (CmmStaticsRaw _ lits))
get_label static = pprPanic "isInitOrFiniArray: invalid entry" (ppr static)
isInitOrFiniArray _ = Nothing
-isInitOrFiniSection :: Section -> Maybe InitOrFini
-isInitOrFiniSection (Section InitArray _) = Just IsInitArray
-isInitOrFiniSection (Section FiniArray _) = Just IsFiniArray
+isInitOrFiniSection :: SectionType -> Maybe InitOrFini
+isInitOrFiniSection InitArray = Just IsInitArray
+isInitOrFiniSection FiniArray = Just IsFiniArray
isInitOrFiniSection _ = Nothing
=====================================
compiler/GHC/CmmToAsm/AArch64/Ppr.hs
=====================================
@@ -19,6 +19,7 @@ import GHC.Cmm.Dataflow.Label
import GHC.Cmm.BlockId
import GHC.Cmm.CLabel
+import GHC.Cmm.InitFini
import GHC.Types.Unique ( pprUniqueAlways, getUnique )
import GHC.Platform
@@ -28,9 +29,7 @@ import GHC.Utils.Panic
pprNatCmmDecl :: IsDoc doc => NCGConfig -> NatCmmDecl RawCmmStatics Instr -> doc
pprNatCmmDecl config (CmmData section dats) =
- let platform = ncgPlatform config
- in
- pprSectionAlign config section $$ pprDatas platform dats
+ pprSectionAlign config section $$ pprDatas config dats
pprNatCmmDecl config proc@(CmmProc top_info lbl _ (ListGraph blocks)) =
let platform = ncgPlatform config
@@ -91,9 +90,20 @@ pprAlignForSection _platform _seg
-- .balign 8
--
pprSectionAlign :: IsDoc doc => NCGConfig -> Section -> doc
-pprSectionAlign config sec@(Section seg _) =
+pprSectionAlign config sec@(Section seg suffix) =
line (pprSectionHeader config sec)
+ $$ coffSplitSectionComdatKey
$$ pprAlignForSection (ncgPlatform config) seg
+ where
+ platform = ncgPlatform config
+ -- See Note [Split sections on COFF objects]
+ coffSplitSectionComdatKey
+ | OSMinGW32 <- platformOS platform
+ , ncgSplitSections config
+ , Nothing <- isInitOrFiniSection seg
+ = line (pprCOFFComdatKey platform suffix <> colon)
+ | otherwise
+ = empty
-- | Output the ELF .size directive.
pprSizeDecl :: IsDoc doc => Platform -> CLabel -> doc
@@ -136,20 +146,26 @@ pprBasicBlock platform with_dwarf info_env (BasicBlock blockid instrs)
(l@LOCATION{} : _) -> pprInstr platform l
_other -> empty
-pprDatas :: IsDoc doc => Platform -> RawCmmStatics -> doc
+pprDatas :: IsDoc doc => NCGConfig -> RawCmmStatics -> doc
-- See Note [emit-time elimination of static indirections] in "GHC.Cmm.CLabel".
-pprDatas platform (CmmStaticsRaw alias [CmmStaticLit (CmmLabel lbl), CmmStaticLit ind, _, _])
+pprDatas config (CmmStaticsRaw alias [CmmStaticLit (CmmLabel lbl), CmmStaticLit ind, _, _])
| lbl == mkIndStaticInfoLabel
, let labelInd (CmmLabelOff l _) = Just l
labelInd (CmmLabel l) = Just l
labelInd _ = Nothing
, Just ind' <- labelInd ind
, alias `mayRedirectTo` ind'
+ -- See Note [Split sections on COFF objects]
+ , not $ platformOS platform == OSMinGW32 && ncgSplitSections config
= pprGloblDecl platform alias
$$ line (text ".equiv" <+> pprAsmLabel platform alias <> comma <> pprAsmLabel platform ind')
+ where
+ platform = ncgPlatform config
-pprDatas platform (CmmStaticsRaw lbl dats)
+pprDatas config (CmmStaticsRaw lbl dats)
= vcat (pprLabel platform lbl : map (pprData platform) dats)
+ where
+ platform = ncgPlatform config
pprData :: IsDoc doc => Platform -> CmmStatic -> doc
pprData _platform (CmmString str) = line (pprString str)
=====================================
compiler/GHC/CmmToAsm/Ppr.hs
=====================================
@@ -1,4 +1,5 @@
{-# LANGUAGE MagicHash #-}
+{-# LANGUAGE MultiWayIf #-}
-----------------------------------------------------------------------------
--
@@ -14,6 +15,7 @@ module GHC.CmmToAsm.Ppr (
pprASCII,
pprString,
pprFileEmbed,
+ pprCOFFComdatKey,
pprSectionHeader
)
@@ -23,6 +25,7 @@ import GHC.Prelude
import GHC.Utils.Asm
import GHC.Cmm.CLabel
+import GHC.Cmm.InitFini
import GHC.Cmm
import GHC.CmmToAsm.Config
import GHC.Utils.Outputable as SDoc
@@ -220,8 +223,8 @@ pprGNUSectionHeader config t suffix =
| otherwise -> text ".rodata"
RelocatableReadOnlyData | OSMinGW32 <- platformOS platform
-- Concept does not exist on Windows,
- -- So map these to R/O data.
- -> text ".rdata$rel.ro"
+ -- So map these to data.
+ -> text ".data"
| otherwise -> text ".data.rel.ro"
UninitialisedData -> text ".bss"
InitArray
@@ -240,24 +243,79 @@ pprGNUSectionHeader config t suffix =
| OSMinGW32 <- platformOS platform
-> text ".rdata"
| otherwise -> text ".ipe"
- flags = case t of
- Text
- | OSMinGW32 <- platformOS platform, splitSections
- -> text ",\"xr\""
- | splitSections
- -> text ",\"ax\"," <> sectionType platform "progbits"
- CString
- | OSMinGW32 <- platformOS platform
- -> empty
- | otherwise -> text ",\"aMS\"," <> sectionType platform "progbits" <> text ",1"
- IPE
- | OSMinGW32 <- platformOS platform
- -> empty
- | otherwise -> text ",\"a\"," <> sectionType platform "progbits"
- _ -> empty
+ flags
+ -- See
+ -- https://github.com/llvm/llvm-project/blob/llvmorg-21.1.8/lld/COFF/Chunks.cpp...
+ -- and https://llvm.org/docs/Extensions.html#section-directive.
+ -- LLD COFF backend gc-sections only work on COMDAT sections so
+ -- we need to mark it as a COMDAT section. You can use clang64
+ -- toolchain to compile small examples with
+ -- `-ffunction-sections -fdata-sections -S` to see these section
+ -- headers in the wild. Also see Note [Split sections on COFF objects]
+ -- below.
+ | OSMinGW32 <- platformOS platform,
+ splitSections =
+ if
+ | Just _ <- isInitOrFiniSection t -> text ",\"dw\""
+ | otherwise ->
+ let coff_section_flags
+ | Text <- t = "xr"
+ | UninitialisedData <- t = "bw"
+ | ReadOnlySection <- sectionProtection t = "dr"
+ | otherwise = "dw"
+ in hcat
+ [ text ",\"",
+ text coff_section_flags,
+ text "\",one_only,",
+ pprCOFFComdatKey platform suffix
+ ]
+ | otherwise =
+ case t of
+ Text
+ | splitSections
+ -> text ",\"ax\"," <> sectionType platform "progbits"
+ CString
+ | OSMinGW32 <- platformOS platform
+ -> empty
+ | otherwise -> text ",\"aMS\"," <> sectionType platform "progbits" <> text ",1"
+ IPE
+ | OSMinGW32 <- platformOS platform
+ -> empty
+ | otherwise -> text ",\"a\"," <> sectionType platform "progbits"
+ _ -> empty
{-# SPECIALIZE pprGNUSectionHeader :: NCGConfig -> SectionType -> CLabel -> SDoc #-}
{-# SPECIALIZE pprGNUSectionHeader :: NCGConfig -> SectionType -> CLabel -> HLine #-} -- see Note [SPECIALIZE to HDoc] in GHC.Utils.Outputable
+-- | Note [Split sections on COFF objects]
+-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+--
+-- On Windows/COFF, LLD's gc-sections only works on COMDAT sections,
+-- so we mark split sections as COMDAT and need to provide a unique
+-- "key" symbol.
+--
+-- Important: We must not use a dot-prefixed local label (e.g.
+-- @.L...@) as the COMDAT key symbol, because LLVM's COFF assembler
+-- treats dot-prefixed COMDAT key symbols specially and forces them to
+-- have value 0 (the beginning of the section). That breaks
+-- @tablesNextToCode@, where the info label is intentionally placed
+-- after the info table data (at a non-zero offset).
+--
+-- Therefore we generate a non-dot-prefixed key symbol derived from
+-- the section suffix, and (see arch-specific 'pprSectionAlign') we
+-- emit a label definition for it at the beginning of the section.
+--
+-- ctor/dtor sections are specially treated; they must be emitted as
+-- regular data sections, otherwise LLD will drop them.
+--
+-- Note that we must not emit .equiv directives for COMDAT sections in
+-- COFF objects, they seriously confuse LLD and we end up with access
+-- violations at runtimes.
+pprCOFFComdatKey :: IsLine doc => Platform -> CLabel -> doc
+pprCOFFComdatKey platform suffix =
+ text "__ghc_coff_comdat_" <> pprAsmLabel platform suffix
+{-# SPECIALIZE pprCOFFComdatKey :: Platform -> CLabel -> SDoc #-}
+{-# SPECIALIZE pprCOFFComdatKey :: Platform -> CLabel -> HLine #-} -- see Note [SPECIALIZE to HDoc] in GHC.Utils.Outputable
+
-- XCOFF doesn't support relocating label-differences, so we place all
-- RO sections into .text[PR] sections
pprXcoffSectionHeader :: IsLine doc => SectionType -> doc
=====================================
compiler/GHC/CmmToAsm/Wasm/FromCmm.hs
=====================================
@@ -107,7 +107,7 @@ symKindFromCLabel lbl
-- | Calculate a data section's kind, see haddock docs of
-- 'DataSectionKind' for more explanation.
dataSectionKindFromCmmSection :: Section -> DataSectionKind
-dataSectionKindFromCmmSection s = case sectionProtection s of
+dataSectionKindFromCmmSection (Section t _) = case sectionProtection t of
ReadWriteSection -> SectionData
_ -> SectionROData
=====================================
compiler/GHC/CmmToAsm/X86/Ppr.hs
=====================================
@@ -31,6 +31,7 @@ import GHC.Cmm hiding (topInfoTable)
import GHC.Cmm.Dataflow.Label
import GHC.Cmm.BlockId
import GHC.Cmm.CLabel
+import GHC.Cmm.InitFini
import GHC.Cmm.DebugBlock (pprUnwindTable)
import GHC.Types.Basic (Alignment, mkAlignment, alignmentBytes)
@@ -195,8 +196,12 @@ pprDatas config (_, CmmStaticsRaw alias [CmmStaticLit (CmmLabel lbl), CmmStaticL
labelInd _ = Nothing
, Just ind' <- labelInd ind
, alias `mayRedirectTo` ind'
+ -- See Note [Split sections on COFF objects]
+ , not $ platformOS platform == OSMinGW32 && ncgSplitSections config
= pprGloblDecl (ncgPlatform config) alias
$$ line (text ".equiv" <+> pprAsmLabel (ncgPlatform config) alias <> comma <> pprAsmLabel (ncgPlatform config) ind')
+ where
+ platform = ncgPlatform config
pprDatas config (align, (CmmStaticsRaw lbl dats))
= vcat (pprAlign platform align : pprLabel platform lbl : map (pprData config) dats)
@@ -526,9 +531,20 @@ pprAddr platform (AddrBaseIndex base index displacement)
-- | Print section header and appropriate alignment for that section.
pprSectionAlign :: IsDoc doc => NCGConfig -> Section -> doc
-pprSectionAlign config sec@(Section seg _) =
+pprSectionAlign config sec@(Section seg suffix) =
line (pprSectionHeader config sec) $$
+ coffSplitSectionComdatKey $$
pprAlignForSection (ncgPlatform config) seg
+ where
+ platform = ncgPlatform config
+ -- See Note [Split sections on COFF objects]
+ coffSplitSectionComdatKey
+ | OSMinGW32 <- platformOS platform
+ , ncgSplitSections config
+ , Nothing <- isInitOrFiniSection seg
+ = line (pprCOFFComdatKey platform suffix <> colon)
+ | otherwise
+ = empty
-- | Print appropriate alignment for the given section type.
pprAlignForSection :: IsDoc doc => Platform -> SectionType -> doc
=====================================
compiler/GHC/CmmToC.hs
=====================================
@@ -121,7 +121,7 @@ pprTop platform = \case
pprDataExterns platform lits $$
pprWordArray platform (isSecConstant section) lbl lits
where
- isSecConstant section = case sectionProtection section of
+ isSecConstant (Section t _) = case sectionProtection t of
ReadOnlySection -> True
WriteProtectedSection -> True
_ -> False
=====================================
compiler/GHC/CmmToLlvm/Data.hs
=====================================
@@ -75,7 +75,7 @@ genLlvmData (sect, statics)
IsFiniArray -> fsLit "llvm.global_dtors"
in genGlobalLabelArray var clbls
-genLlvmData (sec, CmmStaticsRaw lbl xs) = do
+genLlvmData (sec@(Section t _), CmmStaticsRaw lbl xs) = do
label <- strCLabel_llvm lbl
static <- mapM genData xs
lmsec <- llvmSection sec
@@ -92,7 +92,7 @@ genLlvmData (sec, CmmStaticsRaw lbl xs) = do
then Just 2 else Just 1
Section Data _ -> Just $ platformWordSizeInBytes platform
_ -> Nothing
- const = if sectionProtection sec == ReadOnlySection
+ const = if sectionProtection t == ReadOnlySection
then Constant else Global
varDef = LMGlobalVar label tyAlias link lmsec align const
globDef = LMGlobal varDef struct
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/641ec3f01974dff9dfd756f3f049979...
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/641ec3f01974dff9dfd756f3f049979...
You're receiving this email because of your account on gitlab.haskell.org.