[Git][ghc/ghc][wip/T25560] 4 commits: ghc-internal: Disallow setNumCapabilities beyond MAX_N_CAPABILITIES
Ben Gamari (@bgamari)
gitlab at gitlab.haskell.org
Mon Dec 9 14:57:49 UTC 2024
Ben Gamari pushed to branch wip/T25560 at Glasgow Haskell Compiler / GHC
Commits:
68e8a7e0 by Ben Gamari at 2024-12-09T09:57:33-05:00
ghc-internal: Disallow setNumCapabilities beyond MAX_N_CAPABILITIES
Throw an exception instead of segfault.
Fixes #25560.
- - - - -
d87c68d5 by Ben Gamari at 2024-12-09T09:57:37-05:00
ghc-internal: Fix inconsistent FFI import types
The foreign imports of `enabled_capabilities` and
`getNumberOfProcessors` were declared as `CInt` whereas they are defined
as `uint32_t`.
- - - - -
1a122939 by Ben Gamari at 2024-12-09T09:57:37-05:00
testsuite: Add test for #25560
- - - - -
98a3599e by Ben Gamari at 2024-12-09T09:57:37-05:00
rts: Mention maximum capability count in users guide
Addresses #25560.
- - - - -
10 changed files:
- docs/users_guide/using-concurrent.rst
- libraries/ghc-internal/src/GHC/Internal/Conc/Sync.hs
- rts/Capability.c
- rts/Capability.h
- rts/RtsSymbols.c
- rts/include/rts/Config.h
- rts/include/rts/Threads.h
- + testsuite/tests/rts/T25560.hs
- + testsuite/tests/rts/T25560.stderr
- testsuite/tests/rts/all.T
Changes:
=====================================
docs/users_guide/using-concurrent.rst
=====================================
@@ -153,6 +153,13 @@ use the RTS :rts-flag:`-N ⟨x⟩` options.
changed while the program is running by calling
``Control.Concurrent.setNumCapabilities``.
+
+.. note::
+
+ The maximum number of capabilities supported by the GHC runtime system is
+ determined when the compiler is built and currently defaults to 256
+ capabilities.
+
The following options affect the way the runtime schedules threads on
CPUs:
=====================================
libraries/ghc-internal/src/GHC/Internal/Conc/Sync.hs
=====================================
@@ -1,4 +1,3 @@
-{-# LANGUAGE CPP #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE RankNTypes #-}
@@ -381,8 +380,15 @@ to avoid contention with other processes in the machine.
-}
setNumCapabilities :: Int -> IO ()
setNumCapabilities i
- | i <= 0 = failIO $ "setNumCapabilities: Capability count ("++show i++") must be positive"
- | otherwise = c_setNumCapabilities (fromIntegral i)
+ | i <= 0 = failIO $ "setNumCapabilities: Capability count ("++show i++") must be positive"
+ | i > maxCaps = failIO $ "setNumCapabilities: This GHC build only supports up to "++show maxCaps++" capabilities"
+ | otherwise = c_setNumCapabilities (fromIntegral i)
+
+maxCaps :: Int
+maxCaps = unsafeDupablePerformIO $ peek c_maxNumCapabilities
+
+foreign import ccall safe "&max_n_capabilities"
+ c_maxNumCapabilities :: Ptr Int
foreign import ccall safe "setNumCapabilities"
c_setNumCapabilities :: CUInt -> IO ()
@@ -394,13 +400,14 @@ getNumProcessors :: IO Int
getNumProcessors = fmap fromIntegral c_getNumberOfProcessors
foreign import ccall unsafe "getNumberOfProcessors"
- c_getNumberOfProcessors :: IO CUInt
+ c_getNumberOfProcessors :: IO Word32
-- | Returns the number of sparks currently in the local spark pool
numSparks :: IO Int
numSparks = IO $ \s -> case numSparks# s of (# s', n #) -> (# s', I# n #)
-foreign import ccall "&enabled_capabilities" enabled_capabilities :: Ptr CInt
+foreign import ccall "&enabled_capabilities"
+ enabled_capabilities :: Ptr Word32
childHandler :: SomeException -> IO ()
childHandler err = catch (real_handler err) childHandler
=====================================
rts/Capability.c
=====================================
@@ -16,6 +16,7 @@
*
* --------------------------------------------------------------------------*/
+#include "rts/Config.h"
#include "rts/PosixSource.h"
#include "Rts.h"
@@ -40,6 +41,9 @@ Capability MainCapability;
uint32_t n_capabilities = 0;
uint32_t enabled_capabilities = 0;
+// Referenced by GHC.Internal.Conc.Sync
+const StgInt max_n_capabilities = MAX_N_CAPABILITIES;
+
// The array of Capabilities. It's important that when we need
// to allocate more Capabilities we don't have to move the existing
// Capabilities, because there may be pointers to them in use
=====================================
rts/Capability.h
=====================================
@@ -270,6 +270,7 @@ INLINE_HEADER void releaseCapability_ (Capability* cap STG_UNUSED,
// extern Capability MainCapability;
// declared in rts/include/rts/Threads.h:
+// extern const uint32_t max_n_capabilities;
// extern uint32_t n_capabilities;
// extern uint32_t enabled_capabilities;
=====================================
rts/RtsSymbols.c
=====================================
@@ -909,6 +909,7 @@ extern char **environ;
SymI_NeedsDataProto(rts_stop_on_exception) \
SymI_HasProto(stopTimer) \
SymI_HasProto(n_capabilities) \
+ SymI_HasProto(max_n_capabilities) \
SymI_HasProto(enabled_capabilities) \
SymI_HasDataProto(stg_traceEventzh) \
SymI_HasDataProto(stg_traceMarkerzh) \
=====================================
rts/include/rts/Config.h
=====================================
@@ -78,6 +78,9 @@ code.
#endif
#if defined(THREADED_RTS)
+/*
+ * Update the note in docs/users_guide/using-concurrent.rst when updating this.
+ */
#define MAX_N_CAPABILITIES 256
#else
#define MAX_N_CAPABILITIES 1
=====================================
rts/include/rts/Threads.h
=====================================
@@ -77,6 +77,9 @@ INLINE_HEADER unsigned int getNumCapabilities(void)
// The number of Capabilities that are not disabled
extern uint32_t enabled_capabilities;
+// The maximum number of Capabilities supported by the RTS.
+extern const StgInt max_n_capabilities;
+
#if !IN_STG_CODE
extern Capability MainCapability;
#endif
=====================================
testsuite/tests/rts/T25560.hs
=====================================
@@ -0,0 +1,4 @@
+import GHC.Conc
+
+main :: IO ()
+main = setNumCapabilities 100000
=====================================
testsuite/tests/rts/T25560.stderr
=====================================
@@ -0,0 +1,3 @@
+T25560: Uncaught exception ghc-internal:GHC.Internal.IO.Exception.IOException:
+
+user error (setNumCapabilities: This GHC build only supports up to 1 capabilities)
=====================================
testsuite/tests/rts/all.T
=====================================
@@ -630,3 +630,4 @@ test('T24142', [req_target_smp], compile_and_run, ['-threaded -with-rtsopts "-N2
test('T25232', [unless(have_profiling(), skip), only_ways(['normal','nonmoving','nonmoving_prof','nonmoving_thr_prof']), extra_ways(['nonmoving', 'nonmoving_prof'] + (['nonmoving_thr_prof'] if have_threaded() else []))], compile_and_run, [''])
test('T25280', [unless(opsys('linux'),skip),req_process,js_skip], compile_and_run, [''])
+test('T25560', exit_code(1), compile_and_run, [''])
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/a65f7c894eae1f6f165b0c4fac47568a2c670719...98a3599ecc6bb617f7619bc814cff613f80d67d1
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/a65f7c894eae1f6f165b0c4fac47568a2c670719...98a3599ecc6bb617f7619bc814cff613f80d67d1
You're receiving this email because of your account on gitlab.haskell.org.
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20241209/06b2396d/attachment-0001.html>
More information about the ghc-commits
mailing list