[Git][ghc/ghc][wip/T25560] 3 commits: ghc-internal: Disallow setNumCapabilities beyond MAX_N_CAPABILITIES

[Ben Gamari (@bgamari)]

Ben Gamari pushed to branch wip/T25560 at Glasgow Haskell Compiler / GHC


Commits:
26f45603 by Ben Gamari at 2024-12-06T15:16:23-05:00
ghc-internal: Disallow setNumCapabilities beyond MAX_N_CAPABILITIES

Throw an exception instead of segfault.

Fixes #25560.

- - - - -
fb7d665e by Ben Gamari at 2024-12-06T15:16:23-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`.

- - - - -
090cc534 by Ben Gamari at 2024-12-06T15:16:23-05:00
testsuite: Add test for #25560

- - - - -


4 changed files:

- libraries/ghc-internal/src/GHC/Internal/Conc/Sync.hs
- rts/Capability.c
- + testsuite/tests/rts/T25560.hs
- testsuite/tests/rts/all.T


Changes:

=====================================
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 "&maxNumCapabilities"
+  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 maxNumCapabilities = 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


=====================================
testsuite/tests/rts/T25560.hs
=====================================
@@ -0,0 +1,4 @@
+import GHC.Conc
+
+main :: IO ()
+main = setNumCapabilities 100000


=====================================
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/bb62c17c93276aba424b3142aa6321726cc1b014...090cc534766667ae0155e12a3ab766641d78be04

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/bb62c17c93276aba424b3142aa6321726cc1b014...090cc534766667ae0155e12a3ab766641d78be04
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/20241206/4f30554d/attachment-0001.html>