Zubin pushed to branch wip/semaphore-v2 at Glasgow Haskell Compiler / GHC Commits: d7e90c63 by Zubin Duggal at 2026-03-17T16:20:53+05:30 Update to semaphore-compat 2.0.0 using v2 of the protocol Also ensure backwards compatibility with older/newer version of the protocol, by means of graceful degradating to -j1 with a warning. For more details on backwards compatibility, see the accompanying MR to semaphore-compat https://gitlab.haskell.org/ghc/semaphore-compat/-/merge_requests/8 and the BackwardsCompatibility.md file therein. Fixes https://gitlab.haskell.org/ghc/ghc/-/issues/25087 - - - - - 15 changed files: - compiler/GHC/Driver/Errors/Ppr.hs - compiler/GHC/Driver/Errors/Types.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/MakeAction.hs - compiler/GHC/Driver/MakeSem.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Types/Error/Codes.hs - docs/users_guide/using-warnings.rst - docs/users_guide/using.rst - hadrian/cabal.project - hadrian/hadrian.cabal - hadrian/src/Flavour.hs - hadrian/src/Rules/Generate.hs - hadrian/src/Settings/Packages.hs - libraries/semaphore-compat Changes: ===================================== compiler/GHC/Driver/Errors/Ppr.hs ===================================== @@ -282,6 +282,15 @@ instance Diagnostic DriverMessage where -> mkSimpleDecorated $ vcat [ text "The following modules are missing a linkable which is needed for creating a library:" , nest 2 $ hcat (map ppr mods) ] + DriverSemaphoreVersionMismatch received supported + -> mkSimpleDecorated $ + text "Semaphore version mismatch (received v" <> int received <> + text ", this GHC supports v" <> int supported <> + text "); ignoring -jsem and compiling sequentially." + DriverSemaphoreOpenFailure reason + -> mkSimpleDecorated $ + text "Failed to open -jsem semaphore:" <+> text reason <> + text "; ignoring -jsem and compiling sequentially." diagnosticReason = \case DriverUnknownMessage m @@ -355,6 +364,10 @@ instance Diagnostic DriverMessage where -> WarningWithoutFlag DriverMissingLinkableForModule {} -> ErrorWithoutFlag + DriverSemaphoreVersionMismatch {} + -> WarningWithFlag Opt_WarnSemaphoreVersionMismatch + DriverSemaphoreOpenFailure {} + -> WarningWithFlag Opt_WarnSemaphoreOpenFailure diagnosticHints = \case DriverUnknownMessage m @@ -430,5 +443,14 @@ instance Diagnostic DriverMessage where -> noHints DriverMissingLinkableForModule {} -> noHints + DriverSemaphoreVersionMismatch received _supported + | received < _supported + -> [UnknownHint (text "The parent process (e.g. cabal-install) uses an older semaphore protocol." + $$ text "Upgrading cabal-install may resolve this." :: SDoc)] + | otherwise + -> [UnknownHint (text "The parent process (e.g. cabal-install) uses a newer semaphore protocol." + $$ text "Upgrading GHC may resolve this." :: SDoc)] + DriverSemaphoreOpenFailure {} + -> noHints diagnosticCode = constructorCode @GHC ===================================== compiler/GHC/Driver/Errors/Types.hs ===================================== @@ -419,6 +419,23 @@ data DriverMessage where DriverMissingLinkableForModule :: ![Module] -> DriverMessage + {-| DriverSemaphoreVersionMismatch is a warning that occurs when GHC + receives a @-jsem@ semaphore name whose protocol version is incompatible + with the version this GHC supports. GHC ignores @-jsem@ and compiles + sequentially. + + The first field is the received version (or 1 for unversioned names), + the second is the version this GHC supports. + -} + DriverSemaphoreVersionMismatch :: !Int -> !Int -> DriverMessage + + {-| DriverSemaphoreOpenFailure is a warning that occurs when GHC fails to + open the semaphore specified by @-jsem@ (e.g. the socket does not exist + or a system error occurred). GHC ignores @-jsem@ and compiles + sequentially. + -} + DriverSemaphoreOpenFailure :: !String -> DriverMessage + deriving instance Generic DriverMessage data DriverMessageOpts = ===================================== compiler/GHC/Driver/Flags.hs ===================================== @@ -1110,6 +1110,8 @@ data WarningFlag = -- See Note [Quantifying over equalities in RULES] in GHC.Tc.Gen.Sig | Opt_WarnUnusableUnpackPragmas -- Since 9.14 | Opt_WarnPatternNamespaceSpecifier -- Since 9.14 + | Opt_WarnSemaphoreVersionMismatch -- Since 10.0.1 + | Opt_WarnSemaphoreOpenFailure -- Since 10.0.1 deriving (Eq, Ord, Show, Enum, Bounded) -- | Return the names of a WarningFlag @@ -1231,6 +1233,8 @@ warnFlagNames wflag = case wflag of Opt_WarnRuleLhsEqualities -> "rule-lhs-equalities" :| [] Opt_WarnUnusableUnpackPragmas -> "unusable-unpack-pragmas" :| [] Opt_WarnPatternNamespaceSpecifier -> "pattern-namespace-specifier" :| [] + Opt_WarnSemaphoreVersionMismatch -> "semaphore-version-mismatch" :| [] + Opt_WarnSemaphoreOpenFailure -> "semaphore-open-failure" :| [] -- ----------------------------------------------------------------------------- -- Standard sets of warning options @@ -1376,7 +1380,9 @@ standardWarnings -- see Note [Documenting warning flags] Opt_WarnUselessSpecialisations, Opt_WarnDeprecatedPragmas, Opt_WarnRuleLhsEqualities, - Opt_WarnUnusableUnpackPragmas + Opt_WarnUnusableUnpackPragmas, + Opt_WarnSemaphoreVersionMismatch, + Opt_WarnSemaphoreOpenFailure ] -- | Things you get with @-W@. ===================================== compiler/GHC/Driver/MakeAction.hs ===================================== @@ -28,6 +28,16 @@ import GHC.Driver.Errors.Types import GHC.Driver.Messager import GHC.Driver.MakeSem +import System.Semaphore + ( SemaphoreError(..) + , semaphoreVersion, versionsAreCompatible, parseSemaphoreName ) + +import GHC.Driver.Config.Diagnostic ( initDiagOpts, initPrintConfig ) +import GHC.Driver.Errors ( printOrThrowDiagnostics ) +import GHC.Driver.Errors.Types ( DriverMessage(..), GhcMessage(..) ) +import GHC.Types.Error ( singleMessage ) +import GHC.Types.SrcLoc ( noSrcSpan ) +import GHC.Utils.Error ( mkPlainMsgEnvelope ) import GHC.Utils.Logger import GHC.Utils.TmpFs @@ -122,17 +132,34 @@ runNjobsAbstractSem n_jobs action = do resetNumCapabilities = set_num_caps n_capabilities MC.bracket_ updNumCapabilities resetNumCapabilities $ action asem -runWorkerLimit :: WorkerLimit -> (AbstractSem -> IO a) -> IO a +runWorkerLimit :: Logger -> DynFlags -> WorkerLimit -> (AbstractSem -> IO a) -> IO a #if defined(wasm32_HOST_ARCH) -runWorkerLimit _ action = do +runWorkerLimit _logger _dflags _ action = do lock <- newMVar () action $ AbstractSem (takeMVar lock) (putMVar lock ()) #else -runWorkerLimit worker_limit action = case worker_limit of +runWorkerLimit logger dflags worker_limit action = case worker_limit of NumProcessorsLimit n_jobs -> runNjobsAbstractSem n_jobs action JSemLimit sem -> - runJSemAbstractSem sem action + let received_ver = case parseSemaphoreName (getSemaphoreName sem) of + Just (ver, _) -> ver + Nothing -> 1 + in if versionsAreCompatible received_ver semaphoreVersion + then do + result <- MC.try $ runJSemAbstractSem sem action + case result of + Right a -> return a + Left (err :: SemaphoreError) -> do + let diag = DriverSemaphoreOpenFailure (show err) + msg = singleMessage $ mkPlainMsgEnvelope (initDiagOpts dflags) noSrcSpan diag + printOrThrowDiagnostics logger (initPrintConfig dflags) (initDiagOpts dflags) (GhcDriverMessage <$> msg) + runNjobsAbstractSem 1 action + else do + let diag = DriverSemaphoreVersionMismatch received_ver semaphoreVersion + msg = singleMessage $ mkPlainMsgEnvelope (initDiagOpts dflags) noSrcSpan diag + printOrThrowDiagnostics logger (initPrintConfig dflags) (initDiagOpts dflags) (GhcDriverMessage <$> msg) + runNjobsAbstractSem 1 action #endif -- | Build and run a pipeline @@ -159,7 +186,7 @@ runParPipelines worker_limit plugin_hsc_env diag_wrapper mHscMessager all_pipeli thread_safe_logger <- liftIO $ makeThreadSafe (hsc_logger plugin_hsc_env) let thread_safe_hsc_env = plugin_hsc_env { hsc_logger = thread_safe_logger } - runWorkerLimit worker_limit $ \abstract_sem -> do + runWorkerLimit (hsc_logger plugin_hsc_env) (hsc_dflags plugin_hsc_env) worker_limit $ \abstract_sem -> do let env = MakeEnv { hsc_env = thread_safe_hsc_env , withLogger = withParLog log_queue_queue_var , compile_sem = abstract_sem ===================================== compiler/GHC/Driver/MakeSem.hs ===================================== @@ -439,7 +439,7 @@ jobserverLoop opts sjs@(Jobserver { jobs = jobs_tvar }) -- | Create a new jobserver using the given semaphore handle. makeJobserver :: SemaphoreName -> IO (AbstractSem, IO ()) makeJobserver sem_name = do - semaphore <- openSemaphore sem_name + semaphore <- openSemaphore sem_name >>= either MC.throwM pure let init_jobs = Jobs { tokensOwned = 1 ===================================== compiler/GHC/Driver/Session.hs ===================================== @@ -2444,6 +2444,8 @@ wWarningFlagsDeps = [minBound..maxBound] >>= \x -> case x of Opt_WarnRuleLhsEqualities -> warnSpec x Opt_WarnUnusableUnpackPragmas -> warnSpec x Opt_WarnPatternNamespaceSpecifier -> warnSpec x + Opt_WarnSemaphoreVersionMismatch -> warnSpec x + Opt_WarnSemaphoreOpenFailure -> warnSpec x warningGroupsDeps :: [(Deprecation, FlagSpec WarningGroup)] warningGroupsDeps = map mk warningGroups ===================================== compiler/GHC/Types/Error/Codes.hs ===================================== @@ -402,6 +402,8 @@ type family GhcDiagnosticCode c = n | n -> c where GhcDiagnosticCode "DriverInstantiationNodeInDependencyGeneration" = 74284 GhcDiagnosticCode "DriverNoConfiguredLLVMToolchain" = 66599 GhcDiagnosticCode "DriverMissingLinkableForModule" = 47338 + GhcDiagnosticCode "DriverSemaphoreVersionMismatch" = 56206 + GhcDiagnosticCode "DriverSemaphoreOpenFailure" = 19877 -- Constraint solver diagnostic codes GhcDiagnosticCode "BadTelescope" = 97739 ===================================== docs/users_guide/using-warnings.rst ===================================== @@ -2706,6 +2706,37 @@ of ``-W(no-)*``. import Data.List.NonEmpty (data (:|)) +.. ghc-flag:: -Wsemaphore-version-mismatch + :shortdesc: warn when GHC receives a ``-jsem`` semaphore whose protocol + version is incompatible with the version this GHC supports. + :type: dynamic + :reverse: -Wno-semaphore-version-mismatch + :category: + + :since: 10.0.1 + + Warn when GHC is invoked with :ghc-flag:`-jsem` but the semaphore + name indicates a protocol version that is incompatible with this GHC + (e.g. an unversioned v1 name passed to a v2 GHC, or vice versa). + When this occurs, GHC ignores ``-jsem`` and compiles modules sequentially. + + This situation typically arises when ``cabal-install`` and GHC are built + against different versions of the ``semaphore-compat`` library. Upgrading + both to versions that use the same protocol resolves the mismatch. + +.. ghc-flag:: -Wsemaphore-open-failure + :shortdesc: warn when GHC cannot open the ``-jsem`` semaphore. + :type: dynamic + :reverse: -Wno-semaphore-open-failure + :category: + + :since: 10.0.1 + + Warn when GHC is invoked with :ghc-flag:`-jsem` but the semaphore + cannot be opened (e.g. the socket does not exist or a system error + occurred). When this occurs, GHC ignores ``-jsem`` and compiles + modules sequentially. + ---- If you're feeling really paranoid, the :ghc-flag:`-dcore-lint` option is a good choice. ===================================== docs/users_guide/using.rst ===================================== @@ -797,7 +797,14 @@ There are two kinds of participants in the GHC Jobserver protocol: Perform compilation in parallel when possible, coordinating with other processes through the semaphore ⟨sem⟩ (specified as a string). - Error if the semaphore doesn't exist. + + If the semaphore's protocol version is incompatible, GHC emits a + :ghc-flag:`-Wsemaphore-version-mismatch` warning and compiles + sequentially. If the semaphore cannot be opened for other reasons + (e.g. the socket does not exist), GHC emits a + :ghc-flag:`-Wsemaphore-open-failure` warning and compiles + sequentially. In both cases GHC uses only the implicit token + inherited from the parent process. Use of ``-jsem`` will override use of :ghc-flag:`-j[⟨n⟩]`, and vice-versa. ===================================== hadrian/cabal.project ===================================== @@ -1,6 +1,7 @@ packages: ./ ../utils/ghc-toolchain/ ../libraries/ghc-platform/ + ../libraries/semaphore-compat/ -- This essentially freezes the build plan for hadrian -- It would be wise to keep this up to date with the state set in .gitlab/ci.sh. ===================================== hadrian/hadrian.cabal ===================================== @@ -170,6 +170,7 @@ executable hadrian , base16-bytestring >= 0.1.1 && < 1.1.0.0 , ghc-platform , ghc-toolchain + , semaphore-compat ghc-options: -Wall -Wincomplete-record-updates -Wredundant-constraints ===================================== hadrian/src/Flavour.hs ===================================== @@ -149,10 +149,6 @@ werror = -- unix has many unused imports , package unix ? mconcat [arg "-Wwarn=unused-imports", arg "-Wwarn=unused-top-binds"] - -- semaphore-compat relies on sem_getvalue as provided by unix, which is - -- not implemented on Darwin and therefore throws a deprecation warning - , package semaphoreCompat - ? mconcat [arg "-Wwarn=deprecations"] ] , builder Ghc ? package rts ===================================== hadrian/src/Rules/Generate.hs ===================================== @@ -25,6 +25,7 @@ import Utilities import GHC.Toolchain as Toolchain hiding (HsCpp(HsCpp)) import GHC.Platform.ArchOS import Settings.Program (ghcWithInterpreter) +import System.Semaphore (semaphoreVersion) -- | Track this file to rebuild generated files whenever it changes. trackGenerateHs :: Expr () @@ -483,6 +484,7 @@ generateSettings settingsFile = do , ("RTS ways", escapeArgs . map show . Set.toList <$> getRtsWays) , ("Relative Global Package DB", pure rel_pkg_db) , ("base unit-id", pure base_unit_id) + , ("Semaphore version", pure (show semaphoreVersion)) ] let showTuple (k, v) = "(" ++ show k ++ ", " ++ show v ++ ")" pure $ case settings of ===================================== hadrian/src/Settings/Packages.hs ===================================== @@ -230,6 +230,10 @@ packageArgs = do , package hpcBin ? builder (Cabal Flags) ? arg "-build-tool-depends" + ------------------------------ semaphore-compat ---------------------------- + , package semaphoreCompat + ? builder (Cabal Flags) ? arg "-build-testing" + ] ghcInternalArgs :: Args ===================================== libraries/semaphore-compat ===================================== @@ -1 +1 @@ -Subproject commit ba87d1bb0209bd9f29bda1c878ddf345f8a2b199 +Subproject commit e67d577b50b6630c589be188fcaf86b58629d782 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d7e90c63eac536d85df23bf59ad1dae4... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d7e90c63eac536d85df23bf59ad1dae4... You're receiving this email because of your account on gitlab.haskell.org.