Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 64bb0e37 by Sylvain Henry at 2025-09-23T14:35:56-04:00 deriveConstants: automatically pass -fcommon CC flag (#26393) By mistake we tried to use deriveConstants without passing `--gcc-flag -fcommon` (which Hadrian does) and it failed. This patch: 1. adds parsing support for constants stored in the .bss section (i.e. when -fcommon isn't passed) 2. enables passing `-fcommon` automatically to the C compiler because Windows requires this for subtle reasons 3. Documents the subtle reasons (1) isn't strictly necessary because we always do (2) but it does no harm and it is still useful if the CC flags ever contain -fno-common - - - - - 2 changed files: - hadrian/src/Settings/Builders/DeriveConstants.hs - utils/deriveConstants/Main.hs Changes: ===================================== hadrian/src/Settings/Builders/DeriveConstants.hs ===================================== @@ -48,4 +48,4 @@ includeCcArgs = do , arg "-Irts/include" , arg $ "-I" ++ rtsPath > "include" , notM targetSupportsSMP ? arg "-DNOSMP" - , arg "-fcommon" ] + ] ===================================== utils/deriveConstants/Main.hs ===================================== @@ -1,3 +1,5 @@ +{-# LANGUAGE LambdaCase #-} + {- ------------------------------------------------------------------------ (c) The GHC Team, 1992-2012 @@ -65,7 +67,17 @@ main = do opts <- parseArgs "mingw32" -> Windows _ -> DefaultOS verbose = o_verbose opts - gccFlags = o_gccFlags opts + gccFlags0 = o_gccFlags opts + -- nm applied to COFF files doesn't correctly report + -- the size of global variable symbols (it reports 0) + -- except for Common symbols (probably because the + -- merge algorithm of Common symbols takes symbol size + -- into account). So we force the use of `-fcommon` + -- here. + -- As far as we know, it is only required on Windows + -- but enabling it on other platforms does no harm, so + -- we enable it unconditionally. + gccFlags = "-fcommon" : gccFlags0 rs <- case os of JS -> getWantedJS _ -> getWanted verbose os tmpdir gccProg gccFlags nmProg @@ -751,7 +763,7 @@ getWanted verbose os tmpdir gccProgram gccFlags nmProgram mobjdumpProgram ++ "Workaround: You may want to pass\n" ++ " --with-nm=$(xcrun --find nm-classic)\n" ++ "to 'configure'.\n" - Just x -> die ("unexpected value round-tripped for CONTROL_GROUP_CONST_291: " ++ show x) + Just x -> die ("unexpected value round-tripped for CONTROL_GROUP_CONST_291: " ++ show x ++ "\n" ++ show m ++ "\n" ++ xs) mapM (lookupResult m) (wanteds (Just os)) where headers = ["#define IN_STG_CODE 0", @@ -841,14 +853,23 @@ getWanted verbose os tmpdir gccProgram gccFlags nmProgram mobjdumpProgram -- and returns ("MAX_Vanilla_REG", 11) parseNmLine line = case words line of - ('_' : n) : "C" : s : _ -> mkP n s - n : "C" : s : _ -> mkP n s - [n, "D", _, s] -> mkP n s - [s, "O", "*COM*", _, n] -> mkP n s + -- in common section + (n : "C" : s : _ ) -> mkP n s -- nm format (ELF, COFF) + [s, "O", "*COM*", _, n] -> mkP n s -- objdump format (ELF) + -- in .bss section + [n, "B", _, s ] -> mkP n s -- nm format (ELF) + [_, "g", "O", ".bss", s, n] -> mkP n s -- objdump format (ELF) + -- in data section + [n, "D", _, s] -> mkP n s -- nm format (ELF) + [_, "g", "O", ".data", s, n] -> mkP n s -- objdump format (ELF) _ -> Nothing - where mkP r s = case (stripPrefix prefix r, readHex s) of + where mkP r s = case (stripPrefix prefix (strip_ r), readHex s) of (Just name, [(size, "")]) -> Just (name, size) _ -> Nothing + -- strip leading underscore: some platforms (e.g. Darwin) add one + strip_ = \case + ('_':n) -> n + n -> n -- On AIX, `nm` isn't able to tell us the symbol size, so we -- need to use `objdump --syms`. However, unlike on OpenBSD, View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/64bb0e3738beba7f7f82a68854417041... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/64bb0e3738beba7f7f82a68854417041... You're receiving this email because of your account on gitlab.haskell.org.