GitLab

Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC

Commits:

224446a2

by Cheng Shao at 2025-12-20T07:49:54-05:00

rts: workaround -Werror=maybe-uninitialized false positives

In some cases gcc might report -Werror=maybe-uninitialized that we
know are false positives, but need to workaround it to make validate
builds with -Werror pass.

251ec087

by Cheng Shao at 2025-12-20T07:49:54-05:00

hadrian: use -Og as C/C++ optimization level when debugging

This commit enables -Og as optimization level when compiling the debug
ways of rts. According to gcc documentation
(https://gcc.gnu.org/onlinedocs/gcc/Optimize-Options.html#index-Og),
-Og is a better choice than -O0 for producing debuggable code. It's
also supported by clang as well, so it makes sense to use it as a
default for debugging. Also add missing -g3 flag to C++ compilation
flags in +debug_info flavour transformer.

fb586c67

by Cheng Shao at 2025-12-20T07:50:36-05:00

compiler: replace DList with OrdList

This patch removes `DList` logic from the compiler and replaces it
with `OrdList` which also supports O(1) concatenation and should be
more memory efficient than the church-encoded `DList`.

6d689b7e

by Cheng Shao at 2025-12-20T11:26:24-05:00

hadrian: add with_profiled_libs flavour transformer

This patch adds a `with_profiled_libs` flavour transformer to hadrian
which is the exact opposite of `no_profiled_libs`. It adds profiling
ways to stage1+ rts/library ways, and doesn't alter other flavour
settings. It is useful when needing to test profiling logic locally
with a quick flavour.

31f9ba76

by Cheng Shao at 2025-12-20T11:26:24-05:00

hadrian: fix missing profiled dynamic libraries in profiled_ghc

This commit fixes the profiled_ghc flavour transformer to include
profiled dynamic libraries as well, since they're supported by GHC
since !12595.

442c9612

by Cheng Shao at 2025-12-20T11:26:25-05:00

ci: set http.postBuffer to mitigate perf notes timeout on some runners

This patch sets http.postBuffer to mitigate the timeout when fetching
perf notes on some runners with slow internet connection. Fixes #26684.

Changes:

.gitlab/ci.sh

@@ -265,6 +265,15 @@ function setup() {
    # testsuite driver!
    git config gc.auto 0
 +  # Some runners still choke at the perf note fetch step, which has to
 +  # do with slow internet connection, see
 +  # https://docs.gitlab.com/topics/git/troubleshooting_git/#error-stream-0-was-not-closed-cleanly
 +  # for the http.postBuffer mitigation. It might seem
 +  # counter-intuitive that "post buffer" helps with fetching, but git
 +  # indeed issues post requests when fetching over https, it's a
 +  # bidirectional negotiation with the remote.
 +  git config http.postBuffer 52428800
++
    info "====================================================="
    info "Toolchain versions"
    info "====================================================="

compiler/GHC/Parser/String.hs

@@ -19,6 +19,7 @@ import Data.Char (chr, ord)
  import qualified Data.Foldable1 as Foldable1
  import qualified Data.List.NonEmpty as NonEmpty
  import Data.Maybe (listToMaybe, mapMaybe)
 +import GHC.Data.OrdList (fromOL, nilOL, snocOL)
  import GHC.Data.StringBuffer (StringBuffer)
  import qualified GHC.Data.StringBuffer as StringBuffer
  import GHC.Parser.CharClass (
@@ -167,16 +168,16 @@ collapseGaps = go
        [] -> panic "gap unexpectedly ended"
  resolveEscapes :: HasChar c => [c] -> Either (c, LexErr) [c]
 -resolveEscapes = go dlistEmpty
 +resolveEscapes = go nilOL
    where
      go !acc = \case
 -      [] -> pure $ dlistToList acc
 +      [] -> pure $ fromOL acc
        Char '\\' : Char '&' : cs -> go acc cs
        backslash@(Char '\\') : cs ->
          case resolveEscapeChar cs of
 -          Right (esc, cs') -> go (acc `dlistSnoc` setChar esc backslash) cs'
 +          Right (esc, cs') -> go (acc `snocOL` setChar esc backslash) cs'
            Left (c, e) -> Left (c, e)
 -      c : cs -> go (acc `dlistSnoc` c) cs
 +      c : cs -> go (acc `snocOL` c) cs
  -- -----------------------------------------------------------------------------
  -- Escape characters
@@ -420,17 +421,3 @@ It's more precisely defined with the following algorithm:
      * Lines with only whitespace characters
 . Calculate the longest prefix of whitespace shared by all lines in the remaining list
  -}
+-
 --- -----------------------------------------------------------------------------
 --- DList
+-
 -newtype DList a = DList ([a] -> [a])
+-
 -dlistEmpty :: DList a
 -dlistEmpty = DList id
+-
 -dlistToList :: DList a -> [a]
 -dlistToList (DList f) = f []
+-
 -dlistSnoc :: DList a -> a -> DList a
 -dlistSnoc (DList f) x = DList (f . (x :))

compiler/GHC/StgToCmm/InfoTableProv.hs

@@ -11,6 +11,7 @@ import GHC.IO (unsafePerformIO)
  #endif
  import Data.Char
 +import Data.Foldable
  import GHC.Prelude
  import GHC.Platform
  import GHC.Types.SrcLoc (pprUserRealSpan, srcSpanFile)
@@ -18,6 +19,7 @@ import GHC.Types.Unique.DSM
  import GHC.Unit.Module
  import GHC.Utils.Outputable
  import GHC.Data.FastString (fastStringToShortText, unpackFS, LexicalFastString(..))
 +import GHC.Data.OrdList (OrdList, nilOL, snocOL)
  import GHC.Cmm
  import GHC.Cmm.CLabel
@@ -286,7 +288,7 @@ data CgInfoProvEnt = CgInfoProvEnt
                                 , ipeSrcSpan :: !StrTabOffset
+                                }
 -data StringTable = StringTable { stStrings :: DList ShortText
 +data StringTable = StringTable { stStrings :: !(OrdList ShortText)
                                 , stLength :: !Int
                                 , stLookup :: !(M.Map ShortText StrTabOffset)
+                                }
@@ -295,7 +297,7 @@ type StrTabOffset = Word32
  emptyStringTable :: StringTable
  emptyStringTable =
 -    StringTable { stStrings = emptyDList
 +    StringTable { stStrings = nilOL
                  , stLength = 0
                  , stLookup = M.empty
+                 }
@@ -303,7 +305,7 @@ emptyStringTable =
  getStringTableStrings :: StringTable -> BS.ByteString
  getStringTableStrings st =
      BSL.toStrict $ BSB.toLazyByteString
 -    $ foldMap f $ dlistToList (stStrings st)
 +    $ foldMap' f $ stStrings st
    where
      f x = BSB.shortByteString (ST.contents x) `mappend` BSB.word8 0
@@ -312,7 +314,7 @@ lookupStringTable str = state $ \st ->
      case M.lookup str (stLookup st) of
        Just off -> (off, st)
        Nothing ->
 -          let !st' = st { stStrings = stStrings st `snoc` str
 +          let !st' = st { stStrings = stStrings st `snocOL` str
                          , stLength  = stLength st + ST.byteLength str + 1
                          , stLookup  = M.insert str res (stLookup st)
+                         }
@@ -359,14 +361,3 @@ foreign import ccall unsafe "ZSTD_compressBound"
  defaultCompressionLevel :: Int
  defaultCompressionLevel = 3
+-
 -newtype DList a = DList ([a] -> [a])
+-
 -emptyDList :: DList a
 -emptyDList = DList id
+-
 -snoc :: DList a -> a -> DList a
 -snoc (DList f) x = DList (f . (x:))
+-
 -dlistToList :: DList a -> [a]
 -dlistToList (DList f) = f []

hadrian/doc/flavours.md

@@ -249,10 +249,6 @@ The supported transformers are listed below:
      <tr>
          <td><code>profiled_ghc</code></td>
          <td>Build the GHC executable with cost-centre profiling support.
 -            It is recommended that you use this in conjunction with `no_dynamic_ghc` since
 -            GHC does not support loading of profiled libraries with the
 -            dynamic linker. You should use a flavour that builds profiling libs and rts,
 -            i.e. not <code>quick</code>. <br>
              This flag adds cost centres with the -fprof-late flag.</td>
      </tr>
      <tr>
@@ -274,6 +270,10 @@ The supported transformers are listed below:
          <td><code>text_simdutf</code></td>
          <td>Enable building the <code>text</code> package with <code>simdutf</code> support.</td>
      </tr>
 +    <tr>
 +        <td><code>with_profiled_libs</code></td>
 +        <td>Enables building of stage1+ libraries and the RTS in profiled build ways (the opposite of <code>no_profiled_libs</code>).</td>
 +    </tr>
      <tr>
          <td><code>no_profiled_libs</code></td>
          <td>Disables building of libraries in profiled build ways.</td>

hadrian/src/Flavour.hs

@@ -15,6 +15,7 @@ module Flavour
    , enableProfiledGhc
    , disableDynamicGhcPrograms
    , disableDynamicLibs
 +  , enableProfiledLibs
    , disableProfiledLibs
    , enableLinting
    , enableHaddock
@@ -62,6 +63,7 @@ flavourTransformers = M.fromList
      , "no_dynamic_libs"  =: disableDynamicLibs
      , "native_bignum"    =: useNativeBignum
      , "text_simdutf"     =: enableTextWithSIMDUTF
 +    , "with_profiled_libs" =: enableProfiledLibs
      , "no_profiled_libs" =: disableProfiledLibs
      , "omit_pragmas"     =: omitPragmas
      , "ipe"              =: enableIPE
@@ -169,6 +171,7 @@ enableDebugInfo :: Flavour -> Flavour
  enableDebugInfo = addArgs $ notStage0 ? mconcat
      [ builder (Ghc CompileHs) ? pure ["-g3"]
      , builder (Ghc CompileCWithGhc) ? pure ["-optc-g3"]
 +    , builder (Ghc CompileCppWithGhc) ? pure ["-optcxx-g3"]
      , builder (Cc CompileC) ? arg "-g3"
      , builder (Cabal Setup) ? arg "--disable-library-stripping"
      , builder (Cabal Setup) ? arg "--disable-executable-stripping"
@@ -307,29 +310,11 @@ enableUBSan =
  viaLlvmBackend :: Flavour -> Flavour
  viaLlvmBackend = addArgs $ notStage0 ? builder Ghc ? arg "-fllvm"
 --- | Build the GHC executable with profiling enabled in stages 2 and later. It
 --- is also recommended that you use this with @'dynamicGhcPrograms' = False@
 --- since GHC does not support loading of profiled libraries with the
 --- dynamically-linker.
 +-- | Build the GHC executable with profiling enabled in stages 2 and
 +-- later.
  enableProfiledGhc :: Flavour -> Flavour
  enableProfiledGhc flavour =
 -  enableLateCCS flavour
 -    { rtsWays = do
 -        ws <- rtsWays flavour
 -        mconcat
 -          [ pure ws
 -          , buildingCompilerStage' (>= Stage2) ? pure (foldMap profiled_ways ws)
 -          ]
 -    , libraryWays = mconcat
 -        [ libraryWays flavour
 -        , buildingCompilerStage' (>= Stage2) ? pure (Set.singleton profiling)
 -        ]
 -    , ghcProfiled = (>= Stage2)
 -    }
 -    where
 -      profiled_ways w
 -        | wayUnit Dynamic w = Set.empty
 -        | otherwise         = Set.singleton (w <> profiling)
 +  enableLateCCS $ enableProfiledLibs flavour { ghcProfiled = (>= Stage2) }
  -- | Disable 'dynamicGhcPrograms'.
  disableDynamicGhcPrograms :: Flavour -> Flavour
@@ -346,6 +331,20 @@ disableDynamicLibs flavour =
      prune :: Ways -> Ways
      prune = fmap $ Set.filter (not . wayUnit Dynamic)
 +-- | Build libraries and the RTS in profiled ways (opposite of
 +-- 'disableProfiledLibs').
 +enableProfiledLibs :: Flavour -> Flavour
 +enableProfiledLibs flavour =
 +  flavour
 +    { libraryWays = addProfilingWays $ libraryWays flavour,
 +      rtsWays = addProfilingWays $ rtsWays flavour
 +    }
 +  where
 +    addProfilingWays :: Ways -> Ways
 +    addProfilingWays ways = do
 +      ws <- ways
 +      buildProfiled <- notStage0
 +      pure $ if buildProfiled then ws <> Set.map (<> profiling) ws else ws
  -- | Don't build libraries in profiled 'Way's.
  disableProfiledLibs :: Flavour -> Flavour

hadrian/src/Settings/Packages.hs

@@ -351,7 +351,7 @@ rtsPackageArgs = package rts ? do
            , Debug     `wayUnit` way          ? pure [ "-DDEBUG"
                                                      , "-fno-omit-frame-pointer"
                                                      , "-g3"
 -                                                    , "-O0" ]
 +                                                    , "-Og" ]
            -- Set the namespace for the rts fs functions
            , arg $ "-DFS_NAMESPACE=rts"

rts/linker/InitFini.c

@@ -75,7 +75,7 @@ static void sortInitFiniList(struct InitFiniList **slist, enum SortOrder order)
          while (*last != NULL && (*last)->next != NULL) {
              struct InitFiniList *s0 = *last;
              struct InitFiniList *s1 = s0->next;
 -            bool flip;
 +            bool flip = false;
              switch (order) {
                  case INCREASING: flip = s0->priority > s1->priority; break;
                  case DECREASING: flip = s0->priority < s1->priority; break;

rts/sm/Sanity.c

@@ -692,7 +692,7 @@ checkCompactObjects(bdescr *bd)
          ASSERT((W_)str == (W_)block + sizeof(StgCompactNFDataBlock));
          StgWord totalW = 0;
 -        StgCompactNFDataBlock *last;
 +        StgCompactNFDataBlock *last = block;
          for ( ; block ; block = block->next) {
              last = block;
              ASSERT(block->owner == str);