[Git][ghc/ghc][master] Add -single-threaded flag to force single threaded rts

[Marge Bot (@marge-bot)]

Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC


Commits:
26df73fb by Oleg Grenrus at 2023-02-15T22:20:57-05:00
Add -single-threaded flag to force single threaded rts

This is the small part of implementing
https://github.com/ghc-proposals/ghc-proposals/pull/240

- - - - -


9 changed files:

- compiler/GHC/Driver/Session.hs
- docs/users_guide/phases.rst
- + testsuite/tests/rts/T22795a.hs
- + testsuite/tests/rts/T22795a.stdout
- + testsuite/tests/rts/T22795b.hs
- + testsuite/tests/rts/T22795b.stdout
- + testsuite/tests/rts/T22795c.hs
- + testsuite/tests/rts/T22795c.stdout
- testsuite/tests/rts/all.T


Changes:

=====================================
compiler/GHC/Driver/Session.hs
=====================================
@@ -2081,6 +2081,7 @@ dynamic_flags_deps = [
          return d)
   , make_ord_flag defGhcFlag "debug"          (NoArg (addWayDynP WayDebug))
   , make_ord_flag defGhcFlag "threaded"       (NoArg (addWayDynP WayThreaded))
+  , make_ord_flag defGhcFlag "single-threaded" (NoArg (removeWayDynP WayThreaded))
 
   , make_ord_flag defGhcFlag "ticky"
       (NoArg (setGeneralFlag Opt_Ticky >> addWayDynP WayDebug))
@@ -2089,7 +2090,7 @@ dynamic_flags_deps = [
     -- is required to get the RTS ticky support.
 
         ----- Linker --------------------------------------------------------
-  , make_ord_flag defGhcFlag "static"         (NoArg removeWayDyn)
+  , make_ord_flag defGhcFlag "static"         (NoArg (removeWayDynP WayDyn))
   , make_ord_flag defGhcFlag "dynamic"        (NoArg (addWayDynP WayDyn))
   , make_ord_flag defGhcFlag "rdynamic" $ noArg $
 #if defined(linux_HOST_OS)
@@ -4187,8 +4188,8 @@ addWay' w dflags0 =
                        (wayUnsetGeneralFlags platform w)
    in dflags3
 
-removeWayDyn :: DynP ()
-removeWayDyn = upd (\dfs -> dfs { targetWays_ = removeWay WayDyn (targetWays_ dfs) })
+removeWayDynP :: Way -> DynP ()
+removeWayDynP w = upd (\dfs -> dfs { targetWays_ = removeWay w (targetWays_ dfs) })
 
 --------------------------
 setGeneralFlag, unSetGeneralFlag :: GeneralFlag -> DynP ()


=====================================
docs/users_guide/phases.rst
=====================================
@@ -1076,6 +1076,7 @@ for example).
     :shortdesc: Use the threaded runtime
     :type: dynamic
     :category: linking
+    :reverse: -single-threaded
 
     Link the program with the "threaded" version of the runtime system.
     The threaded runtime system is so-called because it manages multiple
@@ -1099,6 +1100,16 @@ for example).
        called from multiple OS threads simultaneously. See
        :ref:`ffi-threads`.
 
+.. ghc-flag:: -single-threaded
+    :shortdesc: Use the single-threaded runtime
+    :type: dynamic
+    :category: linking
+    :reverse: -threaded
+
+    :since: 9.8
+
+    Switch to the single threaded (default) version of the runtime.
+
 .. ghc-flag:: -eventlog
     :shortdesc: Enable runtime event tracing
     :type: dynamic


=====================================
testsuite/tests/rts/T22795a.hs
=====================================
@@ -0,0 +1,6 @@
+module Main (main) where
+
+import System.Posix.Internals (hostIsThreaded)
+
+main :: IO ()
+main = print hostIsThreaded


=====================================
testsuite/tests/rts/T22795a.stdout
=====================================
@@ -0,0 +1 @@
+True


=====================================
testsuite/tests/rts/T22795b.hs
=====================================
@@ -0,0 +1,6 @@
+module Main (main) where
+
+import System.Posix.Internals (hostIsThreaded)
+
+main :: IO ()
+main = print hostIsThreaded


=====================================
testsuite/tests/rts/T22795b.stdout
=====================================
@@ -0,0 +1 @@
+False


=====================================
testsuite/tests/rts/T22795c.hs
=====================================
@@ -0,0 +1,6 @@
+module Main (main) where
+
+import System.Posix.Internals (hostIsThreaded)
+
+main :: IO ()
+main = print hostIsThreaded


=====================================
testsuite/tests/rts/T22795c.stdout
=====================================
@@ -0,0 +1 @@
+False


=====================================
testsuite/tests/rts/all.T
=====================================
@@ -568,3 +568,8 @@ test('decodeMyStack_emptyListForMissingFlag',
   , ignore_stderr
   , js_broken(22261) # cloneMyStack# not yet implemented
   ], compile_and_run, [''])
+
+# Skip for JS platform as the JS RTS is always single threaded
+test('T22795a', [js_skip], compile_and_run, ['-threaded'])
+test('T22795b', [js_skip], compile_and_run, ['-single-threaded'])
+test('T22795c', [js_skip], compile_and_run, ['-threaded -single-threaded'])



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/26df73fb0d7a5422c209fb4f10d0e2f73f6388aa

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/26df73fb0d7a5422c209fb4f10d0e2f73f6388aa
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/20230215/e929713a/attachment-0001.html>