GitLab

Cheng Shao pushed to branch wip/fix-clang64-split-sections at Glasgow Haskell Compiler / GHC

Commits:

6213bb57

by maralorn at 2026-01-02T16:30:32+01:00

GHC.Internal.Exception.Context: Fix comment

on addExceptionAnnotation

b820ff50
by Janis Voigtlaender at 2026-01-05T02:43:18-05:00
```
GHC.Internal.Control.Monad.replicateM: Fix comment
```

f9bda57b

by Cheng Shao at 2026-01-05T09:25:50+01: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.

9f426e30

by Cheng Shao at 2026-01-05T10:33:30+01: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.

043299ef

by Cheng Shao at 2026-01-05T10:42:34+01: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.

Co-authored-by: Codex <codex@openai.com>

8 changed files:

compiler/GHC/Cmm.hs
compiler/GHC/Cmm/InitFini.hs
compiler/GHC/CmmToAsm/Ppr.hs
compiler/GHC/CmmToAsm/Wasm/FromCmm.hs
compiler/GHC/CmmToC.hs
compiler/GHC/CmmToLlvm/Data.hs
libraries/ghc-internal/src/GHC/Internal/Control/Monad.hs
libraries/ghc-internal/src/GHC/Internal/Exception/Context.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/Ppr.hs

  {-# LANGUAGE MagicHash #-}
 +{-# LANGUAGE MultiWayIf #-}
  -----------------------------------------------------------------------------
  --
@@ -23,6 +24,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
@@ -240,21 +242,45 @@ 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#L54
 +      -- 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.
 +      | OSMinGW32 <- platformOS platform,
 +        splitSections =
 +          if
 +            | Just _ <- isInitOrFiniSection t -> text ",\"dw\""
 +            | otherwise ->
 +                let coff_section_flags
 +                      | Text <- t = "xr"
 +                      | UninitialisedData <- t = "bw"
 +                      | ReadWriteSection <- sectionProtection t = "dw"
 +                      | otherwise = "dr"
 +                 in hcat
 +                      [ text ",\"",
 +                        text coff_section_flags,
 +                        text "\",one_only,",
 +                        pprAsmLabel 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

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/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

libraries/ghc-internal/src/GHC/Internal/Control/Monad.hs

@@ -314,7 +314,7 @@ Core: https://gitlab.haskell.org/ghc/ghc/issues/11795#note_118976
  -- | @'replicateM' n act@ performs the action @act@ @n@ times,
  -- and then returns the list of results.
  --
 --- @replicateM n (pure x) == 'replicate' n x@
 +-- @replicateM n (pure x) == pure ('replicate' n x)@
  --
  -- ==== __Examples__
  --

libraries/ghc-internal/src/GHC/Internal/Exception/Context.hs

@@ -64,7 +64,7 @@ instance Monoid ExceptionContext where
  emptyExceptionContext :: ExceptionContext
  emptyExceptionContext = ExceptionContext []
 --- | Construct a singleton 'ExceptionContext' from an 'ExceptionAnnotation'.
 +-- | Add an 'ExceptionAnnotation' to a given 'ExceptionContext'.
  --
  -- @since base-4.20.0.0
  addExceptionAnnotation :: ExceptionAnnotation a => a -> ExceptionContext -> ExceptionContext