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

Commits:

22 changed files:

Changes:

  • .gitlab/generate-ci/gen_ci.hs
    ... ... @@ -1250,7 +1250,7 @@ alpine_x86 =
    1250 1250 
       , fullyStaticBrokenTests (disableValidate (allowFailureGroup (standardBuildsWithConfig Amd64 (Linux Alpine312) staticNativeInt)))
    1251 1251 
         -- Dynamically linked build, suitable for building your own static executables on alpine
    1252 1252 
       , disableValidate (standardBuildsWithConfig Amd64 (Linux Alpine323) (splitSectionsBroken vanilla))
    1253 
    -  , allowFailureGroup (standardBuildsWithConfig I386 (Linux Alpine323) (splitSectionsBroken vanilla))
    1253 
    +  , standardBuildsWithConfig I386 (Linux Alpine323) (splitSectionsBroken vanilla)
    1254 1254 
       ]
    1255 1255 
       where
    1256 1256 
         -- ghcilink002 broken due to #17869

  • .gitlab/jobs.yaml
    ... ... @@ -484,7 +484,7 @@
    484 484 
           ".gitlab/ci.sh clean",
    485 485 
           "cat ci_timings.txt"
    486 486 
         ],
    487 
    -    "allow_failure": true,
    487 
    +    "allow_failure": false,
    488 488 
         "artifacts": {
    489 489 
           "expire_in": "2 weeks",
    490 490 
           "paths": [
    ... ... @@ -1155,7 +1155,7 @@
    1155 1155 
           ".gitlab/ci.sh clean",
    1156 1156 
           "cat ci_timings.txt"
    1157 1157 
         ],
    1158 
    -    "allow_failure": true,
    1158 
    +    "allow_failure": false,
    1159 1159 
         "artifacts": {
    1160 1160 
           "expire_in": "8 weeks",
    1161 1161 
           "paths": [
    ... ... @@ -4034,7 +4034,7 @@
    4034 4034 
           ".gitlab/ci.sh clean",
    4035 4035 
           "cat ci_timings.txt"
    4036 4036 
         ],
    4037 
    -    "allow_failure": true,
    4037 
    +    "allow_failure": false,
    4038 4038 
         "artifacts": {
    4039 4039 
           "expire_in": "1 year",
    4040 4040 
           "paths": [

  • compiler/GHC.hs
    ... ... @@ -719,7 +719,7 @@ setTopSessionDynFlags dflags = do
    719 719 
                           { interpCreateProcess = createIservProcessHook (hsc_hooks hsc_env)
    720 720 
                           }
    721 721
    722 
    -  interp <- liftIO $ initInterpreter tmpfs logger platform finder_cache unit_env interp_opts
    722 
    +  interp <- liftIO $ initInterpreter dflags tmpfs logger platform finder_cache unit_env interp_opts
    723 723
    724 724 
       modifySession $ \h -> hscSetFlags dflags
    725 725 
                             h{ hsc_IC = (hsc_IC h){ ic_dflags = dflags }

  • compiler/GHC/Cmm.hs
    ... ... @@ -278,8 +278,8 @@ data SectionProtection
    278 278 
       deriving (Eq)
    279 279
    280 280 
     -- | Should a data in this section be considered constant at runtime
    281 
    -sectionProtection :: Section -> SectionProtection
    282 
    -sectionProtection (Section t _) = case t of
    281 
    +sectionProtection :: SectionType -> SectionProtection
    282 
    +sectionProtection t = case t of
    283 283 
         Text                    -> ReadOnlySection
    284 284 
         ReadOnlyData            -> ReadOnlySection
    285 285 
         RelocatableReadOnlyData -> WriteProtectedSection

  • compiler/GHC/Cmm/InitFini.hs
    ... ... @@ -2,6 +2,7 @@
    2 2 
     module GHC.Cmm.InitFini
    3 3 
         ( InitOrFini(..)
    4 4 
         , isInitOrFiniArray
    5 
    +    , isInitOrFiniSection
    5 6 
         ) where
    6 7
    7 8 
     import GHC.Prelude
    ... ... @@ -63,8 +64,8 @@ finalizer CmmDecl will be emitted per module.
    63 64 
     data InitOrFini = IsInitArray | IsFiniArray
    64 65
    65 66 
     isInitOrFiniArray :: RawCmmDecl -> Maybe (InitOrFini, [CLabel])
    66 
    -isInitOrFiniArray (CmmData sect (CmmStaticsRaw _ lits))
    67 
    -  | Just initOrFini <- isInitOrFiniSection sect
    67 
    +isInitOrFiniArray (CmmData (Section t _) (CmmStaticsRaw _ lits))
    68 
    +  | Just initOrFini <- isInitOrFiniSection t
    68 69 
       = Just (initOrFini, map get_label lits)
    69 70 
       where
    70 71 
         get_label :: CmmStatic -> CLabel
    ... ... @@ -72,7 +73,7 @@ isInitOrFiniArray (CmmData sect (CmmStaticsRaw _ lits))
    72 73 
         get_label static = pprPanic "isInitOrFiniArray: invalid entry" (ppr static)
    73 74 
     isInitOrFiniArray _ = Nothing
    74 75
    75 
    -isInitOrFiniSection :: Section -> Maybe InitOrFini
    76 
    -isInitOrFiniSection (Section InitArray _) = Just IsInitArray
    77 
    -isInitOrFiniSection (Section FiniArray _) = Just IsFiniArray
    76 
    +isInitOrFiniSection :: SectionType -> Maybe InitOrFini
    77 
    +isInitOrFiniSection InitArray = Just IsInitArray
    78 
    +isInitOrFiniSection FiniArray = Just IsFiniArray
    78 79 
     isInitOrFiniSection _                     = Nothing

  • compiler/GHC/CmmToAsm/AArch64/Ppr.hs
    ... ... @@ -19,6 +19,7 @@ import GHC.Cmm.Dataflow.Label
    19 19
    20 20 
     import GHC.Cmm.BlockId
    21 21 
     import GHC.Cmm.CLabel
    22 
    +import GHC.Cmm.InitFini
    22 23
    23 24 
     import GHC.Types.Unique ( pprUniqueAlways, getUnique )
    24 25 
     import GHC.Platform
    ... ... @@ -28,9 +29,7 @@ import GHC.Utils.Panic
    28 29
    29 30 
     pprNatCmmDecl :: IsDoc doc => NCGConfig -> NatCmmDecl RawCmmStatics Instr -> doc
    30 31 
     pprNatCmmDecl config (CmmData section dats) =
    31 
    -  let platform = ncgPlatform config
    32 
    -  in
    33 
    -  pprSectionAlign config section $$ pprDatas platform dats
    32 
    +  pprSectionAlign config section $$ pprDatas config dats
    34 33
    35 34 
     pprNatCmmDecl config proc@(CmmProc top_info lbl _ (ListGraph blocks)) =
    36 35 
       let platform = ncgPlatform config
    ... ... @@ -91,9 +90,20 @@ pprAlignForSection _platform _seg
    91 90 
     --     .balign 8
    92 91 
     --
    93 92 
     pprSectionAlign :: IsDoc doc => NCGConfig -> Section -> doc
    94 
    -pprSectionAlign config sec@(Section seg _) =
    93 
    +pprSectionAlign config sec@(Section seg suffix) =
    95 94 
         line (pprSectionHeader config sec)
    95 
    +    $$ coffSplitSectionComdatKey
    96 96 
         $$ pprAlignForSection (ncgPlatform config) seg
    97 
    +  where
    98 
    +    platform = ncgPlatform config
    99 
    +    -- See Note [Split sections on COFF objects]
    100 
    +    coffSplitSectionComdatKey
    101 
    +      | OSMinGW32 <- platformOS platform
    102 
    +      , ncgSplitSections config
    103 
    +      , Nothing <- isInitOrFiniSection seg
    104 
    +      = line (pprCOFFComdatKey platform suffix <> colon)
    105 
    +      | otherwise
    106 
    +      = empty
    97 107
    98 108 
     -- | Output the ELF .size directive.
    99 109 
     pprSizeDecl :: IsDoc doc => Platform -> CLabel -> doc
    ... ... @@ -136,20 +146,26 @@ pprBasicBlock platform with_dwarf info_env (BasicBlock blockid instrs)
    136 146 
           (l@LOCATION{} : _) -> pprInstr platform l
    137 147 
           _other             -> empty
    138 148
    139 
    -pprDatas :: IsDoc doc => Platform -> RawCmmStatics -> doc
    149 
    +pprDatas :: IsDoc doc => NCGConfig -> RawCmmStatics -> doc
    140 150 
     -- See Note [emit-time elimination of static indirections] in "GHC.Cmm.CLabel".
    141 
    -pprDatas platform (CmmStaticsRaw alias [CmmStaticLit (CmmLabel lbl), CmmStaticLit ind, _, _])
    151 
    +pprDatas config (CmmStaticsRaw alias [CmmStaticLit (CmmLabel lbl), CmmStaticLit ind, _, _])
    142 152 
       | lbl == mkIndStaticInfoLabel
    143 153 
       , let labelInd (CmmLabelOff l _) = Just l
    144 154 
             labelInd (CmmLabel l) = Just l
    145 155 
             labelInd _ = Nothing
    146 156 
       , Just ind' <- labelInd ind
    147 157 
       , alias `mayRedirectTo` ind'
    158 
    +  -- See Note [Split sections on COFF objects]
    159 
    +  , not $ platformOS platform == OSMinGW32 && ncgSplitSections config
    148 160 
       = pprGloblDecl platform alias
    149 161 
         $$ line (text ".equiv" <+> pprAsmLabel platform alias <> comma <> pprAsmLabel platform ind')
    162 
    +    where
    163 
    +      platform = ncgPlatform config
    150 164
    151 
    -pprDatas platform (CmmStaticsRaw lbl dats)
    165 
    +pprDatas config (CmmStaticsRaw lbl dats)
    152 166 
       = vcat (pprLabel platform lbl : map (pprData platform) dats)
    167 
    +    where
    168 
    +      platform = ncgPlatform config
    153 169
    154 170 
     pprData :: IsDoc doc => Platform -> CmmStatic -> doc
    155 171 
     pprData _platform (CmmString str) = line (pprString str)

  • compiler/GHC/CmmToAsm/Ppr.hs
    1 1 
     {-# LANGUAGE MagicHash #-}
    2 
    +{-# LANGUAGE MultiWayIf #-}
    2 3
    3 4 
     -----------------------------------------------------------------------------
    4 5 
     --
    ... ... @@ -14,6 +15,7 @@ module GHC.CmmToAsm.Ppr (
    14 15 
             pprASCII,
    15 16 
             pprString,
    16 17 
             pprFileEmbed,
    18 
    +        pprCOFFComdatKey,
    17 19 
             pprSectionHeader
    18 20 
     )
    19 21
    ... ... @@ -23,6 +25,7 @@ import GHC.Prelude
    23 25
    24 26 
     import GHC.Utils.Asm
    25 27 
     import GHC.Cmm.CLabel
    28 
    +import GHC.Cmm.InitFini
    26 29 
     import GHC.Cmm
    27 30 
     import GHC.CmmToAsm.Config
    28 31 
     import GHC.Utils.Outputable as SDoc
    ... ... @@ -220,8 +223,8 @@ pprGNUSectionHeader config t suffix =
    220 223 
                         | otherwise -> text ".rodata"
    221 224 
           RelocatableReadOnlyData | OSMinGW32 <- platformOS platform
    222 225 
                                     -- Concept does not exist on Windows,
    223 
    -                                -- So map these to R/O data.
    224 
    -                                          -> text ".rdata$rel.ro"
    226 
    +                                -- So map these to data.
    227 
    +                                          -> text ".data"
    225 228 
                                   | otherwise -> text ".data.rel.ro"
    226 229 
           UninitialisedData -> text ".bss"
    227 230 
           InitArray
    ... ... @@ -240,24 +243,79 @@ pprGNUSectionHeader config t suffix =
    240 243 
             | OSMinGW32 <- platformOS platform
    241 244 
                         -> text ".rdata"
    242 245 
             | otherwise -> text ".ipe"
    243 
    -    flags = case t of
    244 
    -      Text
    245 
    -        | OSMinGW32 <- platformOS platform, splitSections
    246 
    -                    -> text ",\"xr\""
    247 
    -        | splitSections
    248 
    -                    -> text ",\"ax\"," <> sectionType platform "progbits"
    249 
    -      CString
    250 
    -        | OSMinGW32 <- platformOS platform
    251 
    -                    -> empty
    252 
    -        | otherwise -> text ",\"aMS\"," <> sectionType platform "progbits" <> text ",1"
    253 
    -      IPE
    254 
    -        | OSMinGW32 <- platformOS platform
    255 
    -                    -> empty
    256 
    -        | otherwise -> text ",\"a\"," <> sectionType platform "progbits"
    257 
    -      _ -> empty
    246 
    +    flags
    247 
    +      -- See
    248 
    +      -- https://github.com/llvm/llvm-project/blob/llvmorg-21.1.8/lld/COFF/Chunks.cpp#L54
    249 
    +      -- and https://llvm.org/docs/Extensions.html#section-directive.
    250 
    +      -- LLD COFF backend gc-sections only work on COMDAT sections so
    251 
    +      -- we need to mark it as a COMDAT section. You can use clang64
    252 
    +      -- toolchain to compile small examples with
    253 
    +      -- `-ffunction-sections -fdata-sections -S` to see these section
    254 
    +      -- headers in the wild. Also see Note [Split sections on COFF objects]
    255 
    +      -- below.
    256 
    +      | OSMinGW32 <- platformOS platform,
    257 
    +        splitSections =
    258 
    +          if
    259 
    +            | Just _ <- isInitOrFiniSection t -> text ",\"dw\""
    260 
    +            | otherwise ->
    261 
    +                let coff_section_flags
    262 
    +                      | Text <- t = "xr"
    263 
    +                      | UninitialisedData <- t = "bw"
    264 
    +                      | ReadOnlySection <- sectionProtection t = "dr"
    265 
    +                      | otherwise = "dw"
    266 
    +                 in hcat
    267 
    +                      [ text ",\"",
    268 
    +                        text coff_section_flags,
    269 
    +                        text "\",one_only,",
    270 
    +                        pprCOFFComdatKey platform suffix
    271 
    +                      ]
    272 
    +      | otherwise =
    273 
    +          case t of
    274 
    +            Text
    275 
    +              | splitSections
    276 
    +                          -> text ",\"ax\"," <> sectionType platform "progbits"
    277 
    +            CString
    278 
    +              | OSMinGW32 <- platformOS platform
    279 
    +                          -> empty
    280 
    +              | otherwise -> text ",\"aMS\"," <> sectionType platform "progbits" <> text ",1"
    281 
    +            IPE
    282 
    +              | OSMinGW32 <- platformOS platform
    283 
    +                          -> empty
    284 
    +              | otherwise -> text ",\"a\"," <> sectionType platform "progbits"
    285 
    +            _ -> empty
    258 286 
     {-# SPECIALIZE pprGNUSectionHeader :: NCGConfig -> SectionType -> CLabel -> SDoc #-}
    259 287 
     {-# SPECIALIZE pprGNUSectionHeader :: NCGConfig -> SectionType -> CLabel -> HLine #-} -- see Note [SPECIALIZE to HDoc] in GHC.Utils.Outputable
    260 288
    289 
    +-- | Note [Split sections on COFF objects]
    290 
    +-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    291 
    +--
    292 
    +-- On Windows/COFF, LLD's gc-sections only works on COMDAT sections,
    293 
    +-- so we mark split sections as COMDAT and need to provide a unique
    294 
    +-- "key" symbol.
    295 
    +--
    296 
    +-- Important: We must not use a dot-prefixed local label (e.g.
    297 
    +-- @.L...@) as the COMDAT key symbol, because LLVM's COFF assembler
    298 
    +-- treats dot-prefixed COMDAT key symbols specially and forces them to
    299 
    +-- have value 0 (the beginning of the section). That breaks
    300 
    +-- @tablesNextToCode@, where the info label is intentionally placed
    301 
    +-- after the info table data (at a non-zero offset).
    302 
    +--
    303 
    +-- Therefore we generate a non-dot-prefixed key symbol derived from
    304 
    +-- the section suffix, and (see arch-specific 'pprSectionAlign') we
    305 
    +-- emit a label definition for it at the beginning of the section.
    306 
    +--
    307 
    +-- ctor/dtor sections are specially treated; they must be emitted as
    308 
    +-- regular data sections, otherwise LLD will drop them.
    309 
    +--
    310 
    +-- Note that we must not emit .equiv directives for COMDAT sections in
    311 
    +-- COFF objects, they seriously confuse LLD and we end up with access
    312 
    +-- violations at runtimes.
    313 
    +pprCOFFComdatKey :: IsLine doc => Platform -> CLabel -> doc
    314 
    +pprCOFFComdatKey platform suffix =
    315 
    +  text "__ghc_coff_comdat_" <> pprAsmLabel platform suffix
    316 
    +{-# SPECIALIZE pprCOFFComdatKey :: Platform -> CLabel -> SDoc #-}
    317 
    +{-# SPECIALIZE pprCOFFComdatKey :: Platform -> CLabel -> HLine #-} -- see Note [SPECIALIZE to HDoc] in GHC.Utils.Outputable
    318 
    +
    261 319 
     -- XCOFF doesn't support relocating label-differences, so we place all
    262 320 
     -- RO sections into .text[PR] sections
    263 321 
     pprXcoffSectionHeader :: IsLine doc => SectionType -> doc

  • compiler/GHC/CmmToAsm/Wasm/FromCmm.hs
    ... ... @@ -107,7 +107,7 @@ symKindFromCLabel lbl
    107 107 
     -- | Calculate a data section's kind, see haddock docs of
    108 108 
     -- 'DataSectionKind' for more explanation.
    109 109 
     dataSectionKindFromCmmSection :: Section -> DataSectionKind
    110 
    -dataSectionKindFromCmmSection s = case sectionProtection s of
    110 
    +dataSectionKindFromCmmSection (Section t _) = case sectionProtection t of
    111 111 
       ReadWriteSection -> SectionData
    112 112 
       _ -> SectionROData
    113 113

  • compiler/GHC/CmmToAsm/X86/Ppr.hs
    ... ... @@ -31,6 +31,7 @@ import GHC.Cmm hiding (topInfoTable)
    31 31 
     import GHC.Cmm.Dataflow.Label
    32 32 
     import GHC.Cmm.BlockId
    33 33 
     import GHC.Cmm.CLabel
    34 
    +import GHC.Cmm.InitFini
    34 35 
     import GHC.Cmm.DebugBlock (pprUnwindTable)
    35 36
    36 37 
     import GHC.Types.Basic (Alignment, mkAlignment, alignmentBytes)
    ... ... @@ -195,8 +196,12 @@ pprDatas config (_, CmmStaticsRaw alias [CmmStaticLit (CmmLabel lbl), CmmStaticL
    195 196 
             labelInd _ = Nothing
    196 197 
       , Just ind' <- labelInd ind
    197 198 
       , alias `mayRedirectTo` ind'
    199 
    +  -- See Note [Split sections on COFF objects]
    200 
    +  , not $ platformOS platform == OSMinGW32 && ncgSplitSections config
    198 201 
       = pprGloblDecl (ncgPlatform config) alias
    199 202 
         $$ line (text ".equiv" <+> pprAsmLabel (ncgPlatform config) alias <> comma <> pprAsmLabel (ncgPlatform config) ind')
    203 
    +    where
    204 
    +      platform = ncgPlatform config
    200 205
    201 206 
     pprDatas config (align, (CmmStaticsRaw lbl dats))
    202 207 
      = vcat (pprAlign platform align : pprLabel platform lbl : map (pprData config) dats)
    ... ... @@ -526,9 +531,20 @@ pprAddr platform (AddrBaseIndex base index displacement)
    526 531
    527 532 
     -- | Print section header and appropriate alignment for that section.
    528 533 
     pprSectionAlign :: IsDoc doc => NCGConfig -> Section -> doc
    529 
    -pprSectionAlign config sec@(Section seg _) =
    534 
    +pprSectionAlign config sec@(Section seg suffix) =
    530 535 
         line (pprSectionHeader config sec) $$
    536 
    +    coffSplitSectionComdatKey $$
    531 537 
         pprAlignForSection (ncgPlatform config) seg
    538 
    +  where
    539 
    +    platform = ncgPlatform config
    540 
    +    -- See Note [Split sections on COFF objects]
    541 
    +    coffSplitSectionComdatKey
    542 
    +      | OSMinGW32 <- platformOS platform
    543 
    +      , ncgSplitSections config
    544 
    +      , Nothing <- isInitOrFiniSection seg
    545 
    +      = line (pprCOFFComdatKey platform suffix <> colon)
    546 
    +      | otherwise
    547 
    +      = empty
    532 548
    533 549 
     -- | Print appropriate alignment for the given section type.
    534 550 
     pprAlignForSection :: IsDoc doc => Platform -> SectionType -> doc

  • compiler/GHC/CmmToC.hs
    ... ... @@ -121,7 +121,7 @@ pprTop platform = \case
    121 121 
         pprDataExterns platform lits $$
    122 122 
         pprWordArray platform (isSecConstant section) lbl lits
    123 123 
       where
    124 
    -    isSecConstant section = case sectionProtection section of
    124 
    +    isSecConstant (Section t _) = case sectionProtection t of
    125 125 
           ReadOnlySection -> True
    126 126 
           WriteProtectedSection -> True
    127 127 
           _ -> False

  • compiler/GHC/CmmToLlvm/CodeGen.hs
    ... ... @@ -248,6 +248,14 @@ Since x86 PDep/PExt instructions only exist for 32/64 bit widths
    248 248 
     we use the 32bit variant to compute the 8/16bit primops.
    249 249 
     To do so we extend/truncate the argument/result around the
    250 250 
     call.
    251 
    +
    252 
    +Note that the 64-bit intrinsics (`llvm.x86.bmi.pdep.64` and
    253 
    +`llvm.x86.bmi.pext.64`) are only legal on 64-bit x86 targets, not on
    254 
    +i386. Therefore on i386 we must fall back to the runtime helper
    255 
    +(`hs_pdep64`/`hs_pext64`) for the 64-bit primops.
    256 
    +
    257 
    +See https://github.com/llvm/llvm-project/issues/172857 for upstream
    258 
    +discussion about portable pdep/pext intrinsics.
    251 259 
     -}
    252 260 
     genCall (PrimTarget op@(MO_Pdep w)) [dst] args = do
    253 261 
         cfg <- getConfig
    ... ... @@ -970,36 +978,34 @@ cmmPrimOpFunctions mop = do
    970 978 
               W8   -> fsLit "llvm.x86.bmi.pdep.32"
    971 979 
               W16  -> fsLit "llvm.x86.bmi.pdep.32"
    972 980 
               W32  -> fsLit "llvm.x86.bmi.pdep.32"
    973 
    -          W64  -> fsLit "llvm.x86.bmi.pdep.64"
    974 
    -          W128 -> fsLit "llvm.x86.bmi.pdep.128"
    975 
    -          W256 -> fsLit "llvm.x86.bmi.pdep.256"
    976 
    -          W512 -> fsLit "llvm.x86.bmi.pdep.512"
    981 
    +          W64
    982 
    +            | is32bit   -> fsLit "hs_pdep64"
    983 
    +            | otherwise -> fsLit "llvm.x86.bmi.pdep.64"
    984 
    +          -- LLVM only provides x86 PDep/PExt intrinsics for 32/64 bits
    985 
    +          _ -> unsupported
    977 986 
           | otherwise -> case w of
    978 987 
               W8   -> fsLit "hs_pdep8"
    979 988 
               W16  -> fsLit "hs_pdep16"
    980 989 
               W32  -> fsLit "hs_pdep32"
    981 990 
               W64  -> fsLit "hs_pdep64"
    982 
    -          W128 -> fsLit "hs_pdep128"
    983 
    -          W256 -> fsLit "hs_pdep256"
    984 
    -          W512 -> fsLit "hs_pdep512"
    991 
    +          _ -> unsupported
    985 992 
         MO_Pext w
    986 993 
           | isBmi2Enabled -> case w of
    987 994 
               -- See Note [LLVM PDep/PExt intrinsics]
    988 995 
               W8   -> fsLit "llvm.x86.bmi.pext.32"
    989 996 
               W16  -> fsLit "llvm.x86.bmi.pext.32"
    990 997 
               W32  -> fsLit "llvm.x86.bmi.pext.32"
    991 
    -          W64  -> fsLit "llvm.x86.bmi.pext.64"
    992 
    -          W128 -> fsLit "llvm.x86.bmi.pext.128"
    993 
    -          W256 -> fsLit "llvm.x86.bmi.pext.256"
    994 
    -          W512 -> fsLit "llvm.x86.bmi.pext.512"
    998 
    +          W64
    999 
    +            | is32bit   -> fsLit "hs_pext64"
    1000 
    +            | otherwise -> fsLit "llvm.x86.bmi.pext.64"
    1001 
    +          -- LLVM only provides x86 PDep/PExt intrinsics for 32/64 bits
    1002 
    +          _ -> unsupported
    995 1003 
           | otherwise -> case w of
    996 1004 
               W8   -> fsLit "hs_pext8"
    997 1005 
               W16  -> fsLit "hs_pext16"
    998 1006 
               W32  -> fsLit "hs_pext32"
    999 1007 
               W64  -> fsLit "hs_pext64"
    1000 
    -          W128 -> fsLit "hs_pext128"
    1001 
    -          W256 -> fsLit "hs_pext256"
    1002 
    -          W512 -> fsLit "hs_pext512"
    1008 
    +          _ -> unsupported
    1003 1009
    1004 1010 
         MO_AddIntC w    -> case w of
    1005 1011 
           W8   -> fsLit "llvm.sadd.with.overflow.i8"

  • compiler/GHC/CmmToLlvm/Data.hs
    ... ... @@ -75,7 +75,7 @@ genLlvmData (sect, statics)
    75 75 
                     IsFiniArray -> fsLit "llvm.global_dtors"
    76 76 
         in genGlobalLabelArray var clbls
    77 77
    78 
    -genLlvmData (sec, CmmStaticsRaw lbl xs) = do
    78 
    +genLlvmData (sec@(Section t _), CmmStaticsRaw lbl xs) = do
    79 79 
         label <- strCLabel_llvm lbl
    80 80 
         static <- mapM genData xs
    81 81 
         lmsec <- llvmSection sec
    ... ... @@ -92,7 +92,7 @@ genLlvmData (sec, CmmStaticsRaw lbl xs) = do
    92 92 
                                                         then Just 2 else Just 1
    93 93 
                                 Section Data _    -> Just $ platformWordSizeInBytes platform
    94 94 
                                 _                 -> Nothing
    95 
    -        const          = if sectionProtection sec == ReadOnlySection
    95 
    +        const          = if sectionProtection t == ReadOnlySection
    96 96 
                                 then Constant else Global
    97 97 
             varDef         = LMGlobalVar label tyAlias link lmsec align const
    98 98 
             globDef        = LMGlobal varDef struct

  • compiler/GHC/Driver/Session.hs
    ... ... @@ -197,6 +197,8 @@ module GHC.Driver.Session (
    197 197 
             -- * Compiler configuration suitable for display to the user
    198 198 
             compilerInfo,
    199 199
    200 
    +        targetHasRTSWays,
    201 
    +
    200 202 
             wordAlignment,
    201 203
    202 204 
             setUnsafeGlobalDynFlags,
    ... ... @@ -3635,6 +3637,15 @@ compilerInfo dflags
    3635 3637 
         queryCmdMaybe p f = expandDirectories (query (maybe "" (prgPath . p) . f))
    3636 3638 
         queryFlagsMaybe p f = query (maybe "" (unwords . map escapeArg . prgFlags . p) . f)
    3637 3639
    3640 
    +-- | Query if the target RTS has the given 'Ways'. It's computed from
    3641 
    +-- the @"RTS ways"@ field in the settings file.
    3642 
    +targetHasRTSWays :: DynFlags -> Ways -> Bool
    3643 
    +targetHasRTSWays dflags ways
    3644 
    +  | Just ws <- lookup "RTS ways" $ compilerInfo dflags =
    3645 
    +      waysTag ways
    3646 
    +        `elem` words ws
    3647 
    +  | otherwise = panic "RTS ways not found in settings"
    3648 
    +
    3638 3649 
     -- Note [Special unit-ids]
    3639 3650 
     -- ~~~~~~~~~~~~~~~~~~~~~~~
    3640 3651 
     -- Certain units are special to the compiler:

  • compiler/GHC/Runtime/Interpreter/C.hs
    ... ... @@ -8,7 +8,9 @@ where
    8 8
    9 9 
     import GHC.Prelude
    10 10 
     import GHC.Platform
    11 
    +import GHC.Platform.Ways
    11 12 
     import GHC.Data.FastString
    13 
    +import GHC.Driver.Session
    12 14 
     import GHC.Utils.Logger
    13 15 
     import GHC.Utils.TmpFs
    14 16 
     import GHC.Unit.Types
    ... ... @@ -18,11 +20,10 @@ import GHC.Unit.State
    18 20 
     import GHC.Utils.Panic.Plain
    19 21 
     import GHC.Linker.Executable
    20 22 
     import GHC.Linker.Config
    21 
    -import GHC.Utils.CliOption
    22 23
    23 24 
     -- | Generate iserv program for the target
    24 
    -generateIservC :: Logger -> TmpFs -> ExecutableLinkOpts -> UnitEnv -> IO FilePath
    25 
    -generateIservC logger tmpfs opts unit_env = do
    25 
    +generateIservC :: DynFlags -> Logger -> TmpFs -> ExecutableLinkOpts -> UnitEnv -> IO FilePath
    26 
    +generateIservC dflags logger tmpfs opts unit_env = do
    26 27 
       -- get the unit-id of the ghci package. We need this to load the
    27 28 
       -- interpreter code.
    28 29 
       let unit_state = ue_homeUnitState unit_env
    ... ... @@ -60,6 +61,12 @@ generateIservC logger tmpfs opts unit_env = do
    60 61 
               -- must retain CAFs for running interpreted code.
    61 62 
             , leKeepCafs = True
    62 63
    64 
    +          -- link with -threaded if target has threaded RTS
    65 
    +        , leWays =
    66 
    +            let ways = leWays opts
    67 
    +                ways' = addWay WayThreaded ways
    68 
    +            in if targetHasRTSWays dflags ways' then ways' else ways
    69 
    +
    63 70 
               -- enable all rts options
    64 71 
             , leRtsOptsEnabled = RtsOptsAll
    65 72

  • compiler/GHC/Runtime/Interpreter/Init.hs
    ... ... @@ -9,6 +9,7 @@ where
    9 9
    10 10
    11 11 
     import GHC.Prelude
    12 
    +import GHC.Driver.DynFlags
    12 13 
     import GHC.Platform
    13 14 
     import GHC.Platform.Ways
    14 15 
     import GHC.Settings
    ... ... @@ -57,14 +58,15 @@ data InterpOpts = InterpOpts
    57 58
    58 59 
     -- | Initialize code interpreter
    59 60 
     initInterpreter
    60 
    -  :: TmpFs
    61 
    +  :: DynFlags
    62 
    +  -> TmpFs
    61 63 
       -> Logger
    62 64 
       -> Platform
    63 65 
       -> FinderCache
    64 66 
       -> UnitEnv
    65 67 
       -> InterpOpts
    66 68 
       -> IO (Maybe Interp)
    67 
    -initInterpreter tmpfs logger platform finder_cache unit_env opts = do
    69 
    +initInterpreter dflags tmpfs logger platform finder_cache unit_env opts = do
    68 70
    69 71 
       lookup_cache  <- liftIO $ mkInterpSymbolCache
    70 72
    ... ... @@ -125,7 +127,7 @@ initInterpreter tmpfs logger platform finder_cache unit_env opts = do
    125 127 
               dynamic  = interpWays opts `hasWay` WayDyn
    126 128 
             prog <- case interpProg opts of
    127 129 
               -- build iserv program if none specified
    128 
    -          "" -> generateIservC logger tmpfs (interpExecutableLinkOpts opts) unit_env
    130 
    +          "" -> generateIservC dflags logger tmpfs (interpExecutableLinkOpts opts) unit_env
    129 131 
               _ -> pure (interpProg opts ++ flavour)
    130 132 
                 where
    131 133 
                   flavour

  • hadrian/src/Packages.hs
    ... ... @@ -217,7 +217,7 @@ timeoutPath = "testsuite/timeout/install-inplace/bin/timeout" <.> exe
    217 217 
     -- TODO: Can we extract this information from Cabal files?
    218 218 
     -- | Some program packages should not be linked with Haskell main function.
    219 219 
     nonHsMainPackage :: Package -> Bool
    220 
    -nonHsMainPackage = (`elem` [hp2ps, iserv, unlit, ghciWrapper])
    220 
    +nonHsMainPackage = (`elem` [hp2ps, unlit, ghciWrapper])
    221 221
    222 222
    223 223 
     {-

  • hadrian/src/Rules/Gmp.hs
    ... ... @@ -126,6 +126,12 @@ gmpRules = do
    126 126 
                     interpretInContext ctx $
    127 127 
                     mconcat
    128 128 
                         [ getStagedCCFlags
    129 
    +                    -- gmp fails to configure with newer compilers
    130 
    +                    -- that default to c23:
    131 
    +                    -- https://gmplib.org/list-archives/gmp-devel/2025-January/006279.html.
    132 
    +                    -- for now just manually specify -std=gnu11 until
    133 
    +                    -- next upstream release.
    134 
    +                    , arg "-std=gnu11"
    129 135 
                         -- gmp symbols are only used by bignum logic in
    130 136 
                         -- ghc-internal and shouldn't be exported by the
    131 137 
                         -- ghc-internal shared library.

  • hadrian/src/Settings/Packages.hs
    ... ... @@ -41,6 +41,8 @@ packageArgs = do
    41 41 
         libzstdLibraryDir <- getSetting LibZstdLibDir
    42 42 
         stageVersion <- readVersion <$> (expr $ ghcVersionStage stage)
    43 43
    44 
    +    rtsWays <- getRtsWays
    45 
    +
    44 46 
         mconcat
    45 47 
             --------------------------------- base ---------------------------------
    46 48 
             [ package base ? mconcat
    ... ... @@ -185,11 +187,15 @@ packageArgs = do
    185 187 
             --
    186 188 
             -- The Solaris linker does not support --export-dynamic option. It also
    187 189 
             -- does not need it since it exports all dynamic symbols by default
    188 
    -        , package iserv
    189 
    -          ? expr isElfTarget
    190 
    +        , package iserv ? mconcat [
    191 
    +            expr isElfTarget
    190 192 
               ? notM (expr $ anyTargetOs [OSFreeBSD, OSSolaris2])? mconcat
    191 193 
               [ builder (Ghc LinkHs) ? arg "-optl-Wl,--export-dynamic" ]
    192 194
    195 
    +            -- Link iserv with -threaded if possible
    196 
    +          , builder (Cabal Flags) ? any (wayUnit Threaded) rtsWays `cabalFlag` "threaded"
    197 
    +        ]
    198 
    +
    193 199 
             -------------------------------- haddock -------------------------------
    194 200 
             , package haddockApi ?
    195 201 
               builder (Cabal Flags) ? arg "in-ghc-tree"

  • libraries/ghc-internal/configure.ac
    ... ... @@ -195,28 +195,10 @@ dnl--------------------------------------------------------------------
    195 195 
        if test "$HaveFrameworkGMP" = "YES" || test "$HaveLibGmp" = "YES"
    196 196 
        then
    197 197 
            AC_MSG_RESULT([no])
    198 
    -       UseIntreeGmp=0
    199 198 
            AC_CHECK_HEADER([gmp.h], , [AC_MSG_ERROR([Cannot find gmp.h])])
    200 
    -
    201 
    -       AC_MSG_CHECKING([GMP version])
    202 
    -       AC_COMPUTE_INT(GhcGmpVerMj, __GNU_MP_VERSION, [#include <gmp.h>],
    203 
    -           AC_MSG_ERROR([Unable to get value of __GNU_MP_VERSION]))
    204 
    -       AC_COMPUTE_INT(GhcGmpVerMi, __GNU_MP_VERSION_MINOR, [#include <gmp.h>],
    205 
    -           AC_MSG_ERROR([Unable to get value of __GNU_MP_VERSION_MINOR]))
    206 
    -       AC_COMPUTE_INT(GhcGmpVerPl, __GNU_MP_VERSION_PATCHLEVEL, [#include <gmp.h>],
    207 
    -           AC_MSG_ERROR([Unable to get value of __GNU_MP_VERSION_PATCHLEVEL]))
    208 
    -       AC_MSG_RESULT([$GhcGmpVerMj.$GhcGmpVerMi.$GhcGmpVerPl])
    209 
    -
    210 199 
        else
    211 200 
            AC_MSG_RESULT([yes])
    212 
    -       UseIntreeGmp=1
    213 201 
            HaveSecurePowm=1
    214 
    -
    215 
    -       AC_MSG_CHECKING([GMP version])
    216 
    -       GhcGmpVerMj=6
    217 
    -       GhcGmpVerMi=1
    218 
    -       GhcGmpVerPl=2
    219 
    -       AC_MSG_RESULT([$GhcGmpVerMj.$GhcGmpVerMi.$GhcGmpVerPl])
    220 202 
        fi
    221 203
    222 204 
        GMP_INSTALL_INCLUDES="HsIntegerGmp.h ghc-gmp.h"
    ... ... @@ -231,10 +213,6 @@ AC_SUBST(GMP_INSTALL_INCLUDES)
    231 213 
     AC_SUBST(HaveLibGmp)
    232 214 
     AC_SUBST(HaveFrameworkGMP)
    233 215 
     AC_SUBST(HaveSecurePowm)
    234 
    -AC_SUBST(UseIntreeGmp)
    235 
    -AC_SUBST(GhcGmpVerMj)
    236 
    -AC_SUBST(GhcGmpVerMi)
    237 
    -AC_SUBST(GhcGmpVerPl)
    238 216
    239 217 
     # Compute offsets/sizes used by jsbits/base.js
    240 218 
     if test "$host" = "javascript-ghcjs"

  • libraries/ghc-internal/include/HsIntegerGmp.h.in
    1 1 
     #pragma once
    2 2
    3 
    -/* Whether GMP is embedded into ghc-internal */
    4 
    -#define GHC_GMP_INTREE     @UseIntreeGmp@
    5 
    -
    6 
    -/* The following values denote the GMP version used during GHC build-time */
    7 
    -#define GHC_GMP_VERSION_MJ @GhcGmpVerMj@
    8 
    -#define GHC_GMP_VERSION_MI @GhcGmpVerMi@
    9 
    -#define GHC_GMP_VERSION_PL @GhcGmpVerPl@
    10 
    -#define GHC_GMP_VERSION \
    11 
    -    (@GhcGmpVerMj@ * 10000 + @GhcGmpVerMi@ * 100 + @GhcGmpVerPl@)
    12 
    -
    13 3 
     /* Whether GMP supports mpz_powm_sec */
    14 4 
     #define HAVE_SECURE_POWM @HaveSecurePowm@

  • utils/iserv/cbits/iservmain.c deleted
    1 
    -#include <ghcversion.h>
    2 
    -#  include <rts/PosixSource.h>
    3 
    -#include <Rts.h>
    4 
    -
    5 
    -#include <HsFFI.h>
    6 
    -
    7 
    -int main (int argc, char *argv[])
    8 
    -{
    9 
    -    RtsConfig conf = defaultRtsConfig;
    10 
    -
    11 
    -    // We never know what symbols GHC will look up in the future, so
    12 
    -    // we must retain CAFs for running interpreted code.
    13 
    -    conf.keep_cafs = 1;
    14 
    -
    15 
    -    conf.rts_opts_enabled = RtsOptsAll;
    16 
    -    extern StgClosure ZCMain_main_closure;
    17 
    -    hs_main(argc, argv, &ZCMain_main_closure, conf);
    18 
    -}

  • utils/iserv/iserv.cabal.in
    ... ... @@ -23,11 +23,17 @@ Category: Development
    23 23 
     build-type: Simple
    24 24 
     cabal-version: >=1.10
    25 25
    26 
    +Flag threaded
    27 
    +    Description: Link the iserv executable against the threaded RTS
    28 
    +    Default: True
    29 
    +    Manual: True
    30 
    +
    26 31 
     Executable iserv
    27 32 
         Default-Language: Haskell2010
    28 
    -    ghc-options: -no-hs-main
    33 
    +    ghc-options: -fkeep-cafs -rtsopts
    34 
    +    if flag(threaded)
    35 
    +      ghc-options: -threaded
    29 36 
         Main-Is: Main.hs
    30 
    -    C-Sources: cbits/iservmain.c
    31 37 
         Hs-Source-Dirs: src
    32 38 
         include-dirs: .
    33 39 
         Build-Depends:

    • —
    View it on GitLab.
    You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications · Help