Duncan Coutts pushed to branch wip/dcoutts/posix-ticker at Glasgow Haskell Compiler / GHC
Commits:
-
9a9ae4df
by Duncan Coutts at 2026-05-05T14:44:37-04:00
-
2ad3e01e
by Duncan Coutts at 2026-05-05T14:44:37-04:00
-
8ff4fdb5
by David Eichmann at 2026-05-05T14:44:37-04:00
-
96974723
by Teo Camarasu at 2026-05-05T14:45:20-04:00
-
eff6bfaf
by Teo Camarasu at 2026-05-05T14:45:20-04:00
-
1cb1d672
by Wen Kokke at 2026-05-06T09:53:40-04:00
-
9d54dc94
by Wen Kokke at 2026-05-06T09:53:40-04:00
-
418d737b
by Wen Kokke at 2026-05-06T09:53:40-04:00
-
99f4afa4
by Wen Kokke at 2026-05-06T09:53:40-04:00
-
7e9eb8b9
by Wen Kokke at 2026-05-06T09:53:40-04:00
-
3a3045fb
by Wen Kokke at 2026-05-06T09:53:41-04:00
-
a3b339a4
by Teo Camarasu at 2026-05-06T09:54:25-04:00
-
eb922183
by Duncan Coutts at 2026-05-07T14:28:50+01:00
-
01b0e233
by Duncan Coutts at 2026-05-07T14:28:50+01:00
-
bc41d646
by Duncan Coutts at 2026-05-07T14:28:50+01:00
-
4ed9a386
by Duncan Coutts at 2026-05-07T14:28:50+01:00
-
97504fa6
by Duncan Coutts at 2026-05-07T14:28:50+01:00
24 changed files:
- + changelog.d/T27022
- + changelog.d/dynamic-trace-flags
- hadrian/src/Settings/Packages.hs
- libraries/ghci/GHCi/TH.hs
- rts/IOManager.h
- rts/Linker.c
- rts/LinkerInternals.h
- rts/RtsSymbols.c
- rts/RtsSymbols.h
- rts/Trace.c
- rts/Trace.h
- rts/include/rts/EventLogWriter.h
- rts/linker/Elf.c
- + rts/posix/FdWakeup.c
- + rts/posix/FdWakeup.h
- rts/posix/Ticker.c
- − rts/posix/ticker/Pthread.c
- − rts/posix/ticker/TimerFd.c
- rts/rts.cabal
- rts/sm/NonMoving.c
- − testsuite/tests/interface-stability/base-exports.stdout-ws-32
- + testsuite/tests/th/T27022.hs
- + testsuite/tests/th/T27022.stdout
- testsuite/tests/th/all.T
Changes:
| 1 | +section: compiler
|
|
| 2 | +synopsis: Fix a divergence in the interaction between ``recover`` and ``putQ`` between the internal and external interpreter
|
|
| 3 | +description: The ``recover`` method in TemplateHaskell now behaves the same
|
|
| 4 | + with the internal and external interpreter.
|
|
| 5 | + In the past, when an error was encountered in a computation in a ``recover`` block,
|
|
| 6 | + the external interpreter would discard any state changes from ``putQ``,
|
|
| 7 | + whereas the internal interpreter would not.
|
|
| 8 | + This was a long-standing error in the implementation of the external interpreter.
|
|
| 9 | + Both now keep state changes from ``putQ`` in ``recover`` blocks.
|
|
| 10 | +mrs: !15994
|
|
| 11 | +issues: #27022 |
| 1 | +section: compiler
|
|
| 2 | +synopsis: Support dynamic trace flags in RTS
|
|
| 3 | +issues: #27186
|
|
| 4 | +mrs: !15936
|
|
| 5 | + |
|
| 6 | +description: {
|
|
| 7 | + The RTS API now exposes the `RUNTIME_TRACE_FLAG` type and
|
|
| 8 | + the `getTraceFlags` and `setTraceFlags` functions that can be used to
|
|
| 9 | + change the trace flags at runtime.
|
|
| 10 | +} |
| ... | ... | @@ -322,6 +322,7 @@ rtsPackageArgs = package rts ? do |
| 322 | 322 | , Profiling `wayUnit` way ? arg "-DPROFILING"
|
| 323 | 323 | , Threaded `wayUnit` way ? arg "-DTHREADED_RTS"
|
| 324 | 324 | , notM targetSupportsSMP ? arg "-optc-DNOSMP"
|
| 325 | + , isWinHost ? arg "-optl-Wl,--disable-runtime-pseudo-reloc"
|
|
| 325 | 326 | |
| 326 | 327 | -- See Note [AutoApply.cmm for vectors] in genapply/Main.hs
|
| 327 | 328 | --
|
| ... | ... | @@ -119,7 +119,7 @@ initQState :: Pipe -> QState |
| 119 | 119 | initQState p = QState M.empty Nothing p
|
| 120 | 120 | |
| 121 | 121 | -- | The monad in which we run TH computations on the server
|
| 122 | -newtype GHCiQ a = GHCiQ { runGHCiQ :: QState -> IO (a, QState) }
|
|
| 122 | +newtype GHCiQ a = GHCiQ { runGHCiQ :: IORef QState -> IO a }
|
|
| 123 | 123 | |
| 124 | 124 | -- | The exception thrown by "fail" in the GHCiQ monad
|
| 125 | 125 | data GHCiQException = GHCiQException QState String
|
| ... | ... | @@ -128,52 +128,54 @@ data GHCiQException = GHCiQException QState String |
| 128 | 128 | instance Exception GHCiQException
|
| 129 | 129 | |
| 130 | 130 | instance Functor GHCiQ where
|
| 131 | - fmap f (GHCiQ s) = GHCiQ $ fmap (\(x,s') -> (f x,s')) . s
|
|
| 131 | + fmap f (GHCiQ m) = GHCiQ $ fmap f . m
|
|
| 132 | 132 | |
| 133 | 133 | instance Applicative GHCiQ where
|
| 134 | 134 | f <*> a = GHCiQ $ \s ->
|
| 135 | - do (f',s') <- runGHCiQ f s
|
|
| 136 | - (a',s'') <- runGHCiQ a s'
|
|
| 137 | - return (f' a', s'')
|
|
| 138 | - pure x = GHCiQ (\s -> return (x,s))
|
|
| 135 | + do f' <- runGHCiQ f s
|
|
| 136 | + a' <- runGHCiQ a s
|
|
| 137 | + return $ f' a'
|
|
| 138 | + pure x = GHCiQ $ \_ -> return x
|
|
| 139 | 139 | |
| 140 | 140 | instance Monad GHCiQ where
|
| 141 | 141 | m >>= f = GHCiQ $ \s ->
|
| 142 | - do (m', s') <- runGHCiQ m s
|
|
| 143 | - (a, s'') <- runGHCiQ (f m') s'
|
|
| 144 | - return (a, s'')
|
|
| 142 | + do m' <- runGHCiQ m s
|
|
| 143 | + a <- runGHCiQ (f m') s
|
|
| 144 | + return a
|
|
| 145 | 145 | |
| 146 | 146 | instance MonadFail GHCiQ where
|
| 147 | - fail err = GHCiQ $ \s -> throwIO (GHCiQException s err)
|
|
| 147 | + fail err = GHCiQ $ \sRef -> readIORef sRef >>= \s -> throwIO (GHCiQException s err)
|
|
| 148 | 148 | |
| 149 | 149 | getState :: GHCiQ QState
|
| 150 | -getState = GHCiQ $ \s -> return (s,s)
|
|
| 150 | +getState = GHCiQ $ \sRef -> readIORef sRef
|
|
| 151 | 151 | |
| 152 | 152 | noLoc :: TH.Loc
|
| 153 | 153 | noLoc = TH.Loc "<no file>" "<no package>" "<no module>" (0,0) (0,0)
|
| 154 | 154 | |
| 155 | 155 | -- | Send a 'THMessage' to GHC and return the result.
|
| 156 | 156 | ghcCmd :: Binary a => THMessage (THResult a) -> GHCiQ a
|
| 157 | -ghcCmd m = GHCiQ $ \s -> do
|
|
| 157 | +ghcCmd m = GHCiQ $ \sRef -> do
|
|
| 158 | + s <- readIORef sRef
|
|
| 158 | 159 | r <- remoteTHCall (qsPipe s) m
|
| 159 | 160 | case r of
|
| 160 | 161 | THException str -> throwIO (GHCiQException s str)
|
| 161 | - THComplete res -> return (res, s)
|
|
| 162 | + THComplete res -> return res
|
|
| 162 | 163 | |
| 163 | 164 | instance MonadIO GHCiQ where
|
| 164 | - liftIO m = GHCiQ $ \s -> fmap (,s) m
|
|
| 165 | + liftIO m = GHCiQ $ \_ -> m
|
|
| 165 | 166 | |
| 166 | 167 | instance TH.Quasi GHCiQ where
|
| 167 | 168 | qNewName str = ghcCmd (NewName str)
|
| 168 | 169 | qReport isError msg = ghcCmd (Report isError msg)
|
| 169 | 170 | |
| 170 | 171 | -- See Note [TH recover with -fexternal-interpreter] in GHC.Tc.Gen.Splice
|
| 171 | - qRecover (GHCiQ h) a = GHCiQ $ \s -> mask $ \unmask -> do
|
|
| 172 | + qRecover (GHCiQ h) a = GHCiQ $ \sRef -> mask $ \unmask -> do
|
|
| 173 | + s <- readIORef sRef
|
|
| 172 | 174 | remoteTHCall (qsPipe s) StartRecover
|
| 173 | - e <- try $ unmask $ runGHCiQ (a <* ghcCmd FailIfErrs) s
|
|
| 175 | + e <- try $ unmask $ runGHCiQ (a <* ghcCmd FailIfErrs) sRef
|
|
| 174 | 176 | remoteTHCall (qsPipe s) (EndRecover (isLeft e))
|
| 175 | 177 | case e of
|
| 176 | - Left GHCiQException{} -> h s
|
|
| 178 | + Left GHCiQException{} -> h sRef
|
|
| 177 | 179 | Right r -> return r
|
| 178 | 180 | qLookupName isType occ = ghcCmd (LookupName isType occ)
|
| 179 | 181 | qReify name = ghcCmd (Reify name)
|
| ... | ... | @@ -200,15 +202,16 @@ instance TH.Quasi GHCiQ where |
| 200 | 202 | qAddTempFile suffix = ghcCmd (AddTempFile suffix)
|
| 201 | 203 | qAddTopDecls decls = ghcCmd (AddTopDecls decls)
|
| 202 | 204 | qAddForeignFilePath lang fp = ghcCmd (AddForeignFilePath lang fp)
|
| 203 | - qAddModFinalizer fin = GHCiQ (\s -> mkRemoteRef fin >>= return . (, s)) >>=
|
|
| 205 | + qAddModFinalizer fin = GHCiQ (\_ -> mkRemoteRef fin) >>=
|
|
| 204 | 206 | ghcCmd . AddModFinalizer
|
| 205 | 207 | qAddCorePlugin str = ghcCmd (AddCorePlugin str)
|
| 206 | - qGetQ = GHCiQ $ \s ->
|
|
| 208 | + qGetQ = do
|
|
| 209 | + s <- getState
|
|
| 207 | 210 | let lookup :: forall a. Typeable a => Map TypeRep Dynamic -> Maybe a
|
| 208 | 211 | lookup m = fromDynamic =<< M.lookup (typeOf (undefined::a)) m
|
| 209 | - in return (lookup (qsMap s), s)
|
|
| 210 | - qPutQ k = GHCiQ $ \s ->
|
|
| 211 | - return ((), s { qsMap = M.insert (typeOf k) (toDyn k) (qsMap s) })
|
|
| 212 | + return $ lookup (qsMap s)
|
|
| 213 | + qPutQ k = GHCiQ $ \sRef ->
|
|
| 214 | + modifyIORef' sRef (\s -> s { qsMap = M.insert (typeOf k) (toDyn k) (qsMap s) })
|
|
| 212 | 215 | qIsExtEnabled x = ghcCmd (IsExtEnabled x)
|
| 213 | 216 | qExtsEnabled = ghcCmd ExtsEnabled
|
| 214 | 217 | qPutDoc l s = ghcCmd (PutDoc l s)
|
| ... | ... | @@ -231,7 +234,8 @@ runModFinalizerRefs pipe rstate qrefs = do |
| 231 | 234 | qs <- mapM localRef qrefs
|
| 232 | 235 | qstateref <- localRef rstate
|
| 233 | 236 | qstate <- readIORef qstateref
|
| 234 | - _ <- runGHCiQ (TH.runQ $ sequence_ qs) qstate { qsPipe = pipe }
|
|
| 237 | + qstate' <- newIORef $ qstate { qsPipe = pipe }
|
|
| 238 | + _ <- runGHCiQ (TH.runQ $ sequence_ qs) qstate'
|
|
| 235 | 239 | return ()
|
| 236 | 240 | |
| 237 | 241 | -- | The implementation of the 'RunTH' message
|
| ... | ... | @@ -267,8 +271,6 @@ runTHQ |
| 267 | 271 | -> IO ByteString
|
| 268 | 272 | runTHQ pipe rstate mb_loc ghciq = do
|
| 269 | 273 | qstateref <- localRef rstate
|
| 270 | - qstate <- readIORef qstateref
|
|
| 271 | - let st = qstate { qsLocation = mb_loc, qsPipe = pipe }
|
|
| 272 | - (r,new_state) <- runGHCiQ (TH.runQ ghciq) st
|
|
| 273 | - writeIORef qstateref new_state
|
|
| 274 | + modifyIORef' qstateref (\qstate -> qstate { qsLocation = mb_loc, qsPipe = pipe })
|
|
| 275 | + r <- runGHCiQ (TH.runQ ghciq) qstateref
|
|
| 274 | 276 | return $! LB.toStrict (runPut (put r)) |
| ... | ... | @@ -21,6 +21,15 @@ |
| 21 | 21 | |
| 22 | 22 | #include "sm/GC.h" // for evac_fn
|
| 23 | 23 | |
| 24 | +#if defined(mingw32_HOST_OS)
|
|
| 25 | +/* Global var (only on Windows) that is exported (hence before BeginPrivate.h)
|
|
| 26 | + * to be shared with the I/O code in the base library to tell us which style
|
|
| 27 | + * of I/O manager we are using: one that uses the Windows native API HANDLEs,
|
|
| 28 | + * or one that uses Posix style fds.
|
|
| 29 | + */
|
|
| 30 | +extern bool rts_IOManagerIsWin32Native;
|
|
| 31 | +#endif
|
|
| 32 | + |
|
| 24 | 33 | #include "BeginPrivate.h"
|
| 25 | 34 | |
| 26 | 35 | /* The ./configure gives us a set of CPP flags, one for each named I/O manager:
|
| ... | ... | @@ -160,14 +169,6 @@ typedef enum { |
| 160 | 169 | /* Global var to tell us which I/O manager impl we are using */
|
| 161 | 170 | extern IOManagerType iomgr_type;
|
| 162 | 171 | |
| 163 | -#if defined(mingw32_HOST_OS)
|
|
| 164 | -/* Global var (only on Windows) that is exported to be shared with the I/O code
|
|
| 165 | - * in the base library to tell us which style of I/O manager we are using: one
|
|
| 166 | - * that uses the Windows native API HANDLEs, or one that uses Posix style fds.
|
|
| 167 | - */
|
|
| 168 | -extern bool rts_IOManagerIsWin32Native;
|
|
| 169 | -#endif
|
|
| 170 | - |
|
| 171 | 172 | |
| 172 | 173 | /* The CapIOManager is the per-capability data structure belonging to the I/O
|
| 173 | 174 | * manager. It is defined in full in IOManagerInternals.h. The opaque forward
|
| ... | ... | @@ -478,16 +478,7 @@ initLinker_ (int retain_cafs) |
| 478 | 478 | symhash = allocStrHashTable();
|
| 479 | 479 | |
| 480 | 480 | /* populate the symbol table with stuff from the RTS */
|
| 481 | - IF_DEBUG(linker, debugBelch("populating linker symbol table with built-in RTS symbols\n"));
|
|
| 482 | - for (const RtsSymbolVal *sym = rtsSyms; sym->lbl != NULL; sym++) {
|
|
| 483 | - IF_DEBUG(linker, debugBelch("initLinker: inserting rts symbol %s, %p\n", sym->lbl, sym->addr));
|
|
| 484 | - if (! ghciInsertSymbolTable(WSTR("(GHCi built-in symbols)"),
|
|
| 485 | - symhash, sym->lbl, sym->addr,
|
|
| 486 | - sym->strength, sym->type, 0, NULL)) {
|
|
| 487 | - barf("ghciInsertSymbolTable failed");
|
|
| 488 | - }
|
|
| 489 | - }
|
|
| 490 | - IF_DEBUG(linker, debugBelch("done with built-in RTS symbols\n"));
|
|
| 481 | + initLinkerRtsSyms(symhash);
|
|
| 491 | 482 | |
| 492 | 483 | /* Add extra symbols. rtsExtraSyms() is a weakly defined symbol in the rts,
|
| 493 | 484 | * that can be overrided by linking in an object with a corresponding
|
| ... | ... | @@ -502,4 +502,6 @@ ObjectCode* mkOc( ObjectType type, pathchar *path, char *image, int imageSize, |
| 502 | 502 | void initSegment(Segment *s, void *start, size_t size, SegmentProt prot, int n_sections);
|
| 503 | 503 | void freeSegments(ObjectCode *oc);
|
| 504 | 504 | |
| 505 | +void initLinkerRtsSyms(StrHashTable *symhash);
|
|
| 506 | + |
|
| 505 | 507 | #include "EndPrivate.h" |
| ... | ... | @@ -9,6 +9,8 @@ |
| 9 | 9 | #include "ghcplatform.h"
|
| 10 | 10 | #include "Rts.h"
|
| 11 | 11 | #include "RtsSymbols.h"
|
| 12 | +#include "LinkerInternals.h"
|
|
| 13 | +#include "PathUtils.h"
|
|
| 12 | 14 | |
| 13 | 15 | #include "TopHandler.h"
|
| 14 | 16 | #include "HsFFI.h"
|
| ... | ... | @@ -51,6 +53,20 @@ extern char **environ; |
| 51 | 53 | |
| 52 | 54 | /* -----------------------------------------------------------------------------
|
| 53 | 55 | * Symbols to be inserted into the RTS symbol table.
|
| 56 | + *
|
|
| 57 | + * Note [Naming Scheme for Symbol Macros]
|
|
| 58 | + * ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
|
|
| 59 | + *
|
|
| 60 | + * SymI_*: symbol is internal to the RTS. It resides in an object
|
|
| 61 | + * file/library that is linked into the RTS library (as a static
|
|
| 62 | + * archive or dynamic shared library).
|
|
| 63 | + * SymE_*: symbol is external to the RTS library. It might be linked
|
|
| 64 | + * dynamically.
|
|
| 65 | + *
|
|
| 66 | + * Sym*_HasProto : the symbol prototype is imported in an include file
|
|
| 67 | + * or defined explicitly
|
|
| 68 | + * Sym*_NeedsProto: the symbol is undefined and we add a dummy
|
|
| 69 | + * default proto extern void sym(void);
|
|
| 54 | 70 | */
|
| 55 | 71 | |
| 56 | 72 | #define Maybe_Stable_Names SymI_HasProto(stg_mkWeakzh) \
|
| ... | ... | @@ -162,7 +178,7 @@ extern char **environ; |
| 162 | 178 | SymI_HasProto(stg_asyncWritezh) \
|
| 163 | 179 | SymI_HasProto(stg_asyncDoProczh) \
|
| 164 | 180 | SymI_HasProto(rts_InstallConsoleEvent) \
|
| 165 | - SymI_HasProto(rts_IOManagerIsWin32Native) \
|
|
| 181 | + SymI_HasDataProto(rts_IOManagerIsWin32Native) \
|
|
| 166 | 182 | SymI_HasProto(rts_ConsoleHandlerDone) \
|
| 167 | 183 | SymI_NeedsProto(__mingw_module_is_dll) \
|
| 168 | 184 | RTS_WIN64_ONLY(SymI_NeedsProto(___chkstk_ms)) \
|
| ... | ... | @@ -524,7 +540,12 @@ extern char **environ; |
| 524 | 540 | SymI_HasProto(__word_encodeFloat) \
|
| 525 | 541 | SymI_HasDataProto(stg_atomicallyzh) \
|
| 526 | 542 | SymI_HasProto(barf) \
|
| 543 | + SymI_HasProto(startEventLogging) \
|
|
| 544 | + SymI_HasProto(endEventLogging) \
|
|
| 527 | 545 | SymI_HasProto(flushEventLog) \
|
| 546 | + SymI_HasProto(flushEventLog) \
|
|
| 547 | + SymI_HasProto(getTraceFlag) \
|
|
| 548 | + SymI_HasProto(setTraceFlag) \
|
|
| 528 | 549 | SymI_HasProto(deRefStablePtr) \
|
| 529 | 550 | SymI_HasProto(debugBelch) \
|
| 530 | 551 | SymI_HasProto(errorBelch) \
|
| ... | ... | @@ -914,7 +935,7 @@ extern char **environ; |
| 914 | 935 | SymI_HasProto(freeExecPage) \
|
| 915 | 936 | SymI_HasProto(getAllocations) \
|
| 916 | 937 | SymI_HasProto(revertCAFs) \
|
| 917 | - SymI_HasProto(RtsFlags) \
|
|
| 938 | + SymI_HasDataProto(RtsFlags) \
|
|
| 918 | 939 | SymI_NeedsDataProto(rts_breakpoint_io_action) \
|
| 919 | 940 | SymI_NeedsDataProto(rts_stop_next_breakpoint) \
|
| 920 | 941 | SymI_NeedsDataProto(rts_stop_on_exception) \
|
| ... | ... | @@ -925,9 +946,9 @@ extern char **environ; |
| 925 | 946 | SymI_NeedsProto(rts_enableStopAfterReturn) \
|
| 926 | 947 | SymI_NeedsProto(rts_disableStopAfterReturn) \
|
| 927 | 948 | SymI_HasProto(stopTimer) \
|
| 928 | - SymI_HasProto(n_capabilities) \
|
|
| 929 | - SymI_HasProto(max_n_capabilities) \
|
|
| 930 | - SymI_HasProto(enabled_capabilities) \
|
|
| 949 | + SymI_HasDataProto(n_capabilities) \
|
|
| 950 | + SymI_HasDataProto(max_n_capabilities) \
|
|
| 951 | + SymI_HasDataProto(enabled_capabilities) \
|
|
| 931 | 952 | SymI_HasDataProto(stg_traceEventzh) \
|
| 932 | 953 | SymI_HasDataProto(stg_traceMarkerzh) \
|
| 933 | 954 | SymI_HasDataProto(stg_traceBinaryEventzh) \
|
| ... | ... | @@ -1145,12 +1166,27 @@ extern char **environ; |
| 1145 | 1166 | SymI_HasProto(hs_word2float64)
|
| 1146 | 1167 | |
| 1147 | 1168 | |
| 1148 | -/* entirely bogus claims about types of these symbols */
|
|
| 1149 | -#define SymI_NeedsProto(vvv) extern void vvv(void);
|
|
| 1150 | -#define SymI_NeedsDataProto(vvv) extern StgWord vvv[];
|
|
| 1151 | -#define SymE_NeedsProto(vvv) SymI_NeedsProto(vvv);
|
|
| 1152 | -#define SymE_NeedsDataProto(vvv) SymI_NeedsDataProto(vvv);
|
|
| 1153 | -#define SymE_HasProto(vvv) SymI_HasProto(vvv);
|
|
| 1169 | +/* Declare prototypes for the symbols that need it, so we can refer
|
|
| 1170 | + * to them in the rtsSyms table below.
|
|
| 1171 | + *
|
|
| 1172 | + * In particular, for the external ones (SymE_*) we use the dllimport attribute
|
|
| 1173 | + * to indicate that (on Windows) they come from external DLLs. This attribute
|
|
| 1174 | + * is ignored on other platforms.
|
|
| 1175 | + *
|
|
| 1176 | + * The claims about the types of these symbols are entirely bogus.
|
|
| 1177 | + */
|
|
| 1178 | +#if defined(mingw32_HOST_OS) && defined(DYNAMIC)
|
|
| 1179 | +#define DLLIMPORT __attribute__((dllimport))
|
|
| 1180 | +#else
|
|
| 1181 | +#define DLLIMPORT /**/
|
|
| 1182 | +#endif
|
|
| 1183 | + |
|
| 1184 | +#define SymI_NeedsProto(vvv) extern void vvv(void);
|
|
| 1185 | +#define SymI_NeedsDataProto(vvv) extern StgWord vvv[];
|
|
| 1186 | +#define SymE_NeedsProto(vvv) extern DLLIMPORT void vvv(void);
|
|
| 1187 | +#define SymE_NeedsDataProto(vvv) extern DLLIMPORT StgWord vvv[];
|
|
| 1188 | + |
|
| 1189 | +#define SymE_HasProto(vvv) /**/
|
|
| 1154 | 1190 | #define SymI_HasProto(vvv) /**/
|
| 1155 | 1191 | #define SymI_HasDataProto(vvv) /**/
|
| 1156 | 1192 | #define SymI_HasProto_redirect(vvv,xxx,strength,ty) /**/
|
| ... | ... | @@ -1179,6 +1215,8 @@ RTS_SYMBOLS_PRIM |
| 1179 | 1215 | #undef SymE_NeedsProto
|
| 1180 | 1216 | #undef SymE_NeedsDataProto
|
| 1181 | 1217 | |
| 1218 | +/* See Note [Naming Scheme for Symbol Macros] */
|
|
| 1219 | + |
|
| 1182 | 1220 | #define SymI_HasProto(vvv) { MAYBE_LEADING_UNDERSCORE_STR(#vvv), \
|
| 1183 | 1221 | (void*)(&(vvv)), STRENGTH_NORMAL, SYM_TYPE_CODE },
|
| 1184 | 1222 | #define SymI_HasDataProto(vvv) { MAYBE_LEADING_UNDERSCORE_STR(#vvv), \
|
| ... | ... | @@ -1199,7 +1237,16 @@ RTS_SYMBOLS_PRIM |
| 1199 | 1237 | { MAYBE_LEADING_UNDERSCORE_STR(#vvv), \
|
| 1200 | 1238 | (void*)(&(xxx)), strength, ty },
|
| 1201 | 1239 | |
| 1202 | -RtsSymbolVal rtsSyms[] = {
|
|
| 1240 | + |
|
| 1241 | + |
|
| 1242 | +/* Initialize (if not already initialized) and return an array of symbols with stuff from the RTS. */
|
|
| 1243 | +void initLinkerRtsSyms (StrHashTable *symhash) {
|
|
| 1244 | + /* The address of data symbols with the dllimport attribute are not
|
|
| 1245 | + * compile-time constants and so cannot be used in constant initialisers.
|
|
| 1246 | + * For this reason, rtsSyms is a local variable within this function
|
|
| 1247 | + * rather than a global constant (as it was historically).
|
|
| 1248 | + */
|
|
| 1249 | + const RtsSymbolVal rtsSyms[] = {
|
|
| 1203 | 1250 | RTS_SYMBOLS
|
| 1204 | 1251 | RTS_RET_SYMBOLS
|
| 1205 | 1252 | RTS_POSIX_ONLY_SYMBOLS
|
| ... | ... | @@ -1214,7 +1261,20 @@ RtsSymbolVal rtsSyms[] = { |
| 1214 | 1261 | RTS_SYMBOLS_PRIM
|
| 1215 | 1262 | SymI_HasDataProto(nonmoving_write_barrier_enabled)
|
| 1216 | 1263 | { 0, 0, STRENGTH_NORMAL, SYM_TYPE_CODE } /* sentinel */
|
| 1217 | -};
|
|
| 1264 | + };
|
|
| 1265 | + |
|
| 1266 | + IF_DEBUG(linker, debugBelch("populating linker symbol table with built-in RTS symbols\n"));
|
|
| 1267 | + for (const RtsSymbolVal *sym = rtsSyms; sym->lbl != NULL; sym++) {
|
|
| 1268 | + IF_DEBUG(linker, debugBelch("initLinker: inserting rts symbol %s, %p\n", sym->lbl, sym->addr));
|
|
| 1269 | + if (! ghciInsertSymbolTable(WSTR("(GHCi built-in symbols)"),
|
|
| 1270 | + symhash, sym->lbl, sym->addr,
|
|
| 1271 | + sym->strength, sym->type, 0, NULL)) {
|
|
| 1272 | + barf("ghciInsertSymbolTable failed");
|
|
| 1273 | + }
|
|
| 1274 | + }
|
|
| 1275 | + IF_DEBUG(linker, debugBelch("done with built-in RTS symbols\n"));
|
|
| 1276 | +}
|
|
| 1277 | + |
|
| 1218 | 1278 | |
| 1219 | 1279 | |
| 1220 | 1280 | // Note [Extra RTS symbols]
|
| ... | ... | @@ -46,8 +46,6 @@ typedef struct _RtsSymbolVal { |
| 46 | 46 | SymType type;
|
| 47 | 47 | } RtsSymbolVal;
|
| 48 | 48 | |
| 49 | -extern RtsSymbolVal rtsSyms[];
|
|
| 50 | - |
|
| 51 | 49 | extern RtsSymbolVal* __attribute__((weak)) rtsExtraSyms(void);
|
| 52 | 50 | |
| 53 | 51 | /* See Note [_iob_func symbol]. */
|
| ... | ... | @@ -29,14 +29,54 @@ |
| 29 | 29 | #include <unistd.h>
|
| 30 | 30 | #endif
|
| 31 | 31 | |
| 32 | -// events
|
|
| 33 | -uint8_t TRACE_sched;
|
|
| 34 | -uint8_t TRACE_gc;
|
|
| 35 | -uint8_t TRACE_nonmoving_gc;
|
|
| 36 | -uint8_t TRACE_spark_sampled;
|
|
| 37 | -uint8_t TRACE_spark_full;
|
|
| 38 | -uint8_t TRACE_user;
|
|
| 39 | -uint8_t TRACE_cap;
|
|
| 32 | +RUNTIME_TRACE_FLAG_CACHE RuntimeTraceFlagCache = {0};
|
|
| 33 | + |
|
| 34 | +bool getTraceFlag(RUNTIME_TRACE_FLAG flag) {
|
|
| 35 | + switch (flag) {
|
|
| 36 | + case TRACE_SCHEDULER:
|
|
| 37 | + return RuntimeTraceFlagCache.scheduler;
|
|
| 38 | + case TRACE_GC:
|
|
| 39 | + return RuntimeTraceFlagCache.gc;
|
|
| 40 | + case TRACE_NONMOVING_GC:
|
|
| 41 | + return RuntimeTraceFlagCache.nonmoving_gc;
|
|
| 42 | + case TRACE_SPARK_SAMPLED:
|
|
| 43 | + return RuntimeTraceFlagCache.spark_sampled;
|
|
| 44 | + case TRACE_SPARK_FULL:
|
|
| 45 | + return RuntimeTraceFlagCache.spark_full;
|
|
| 46 | + case TRACE_USER:
|
|
| 47 | + return RuntimeTraceFlagCache.user;
|
|
| 48 | + case TRACE_CAP:
|
|
| 49 | + return RuntimeTraceFlagCache.cap;
|
|
| 50 | + default:
|
|
| 51 | + return false;
|
|
| 52 | + }
|
|
| 53 | +}
|
|
| 54 | + |
|
| 55 | +void setTraceFlag(RUNTIME_TRACE_FLAG flag, bool value) {
|
|
| 56 | + switch (flag) {
|
|
| 57 | + case TRACE_SCHEDULER:
|
|
| 58 | + RuntimeTraceFlagCache.scheduler = value;
|
|
| 59 | + break;
|
|
| 60 | + case TRACE_GC:
|
|
| 61 | + RuntimeTraceFlagCache.gc = value;
|
|
| 62 | + break;
|
|
| 63 | + case TRACE_NONMOVING_GC:
|
|
| 64 | + RuntimeTraceFlagCache.nonmoving_gc = value;
|
|
| 65 | + break;
|
|
| 66 | + case TRACE_SPARK_SAMPLED:
|
|
| 67 | + RuntimeTraceFlagCache.spark_sampled = value;
|
|
| 68 | + break;
|
|
| 69 | + case TRACE_SPARK_FULL:
|
|
| 70 | + RuntimeTraceFlagCache.spark_full = value;
|
|
| 71 | + break;
|
|
| 72 | + case TRACE_USER:
|
|
| 73 | + RuntimeTraceFlagCache.user = value;
|
|
| 74 | + break;
|
|
| 75 | + case TRACE_CAP:
|
|
| 76 | + RuntimeTraceFlagCache.cap = value;
|
|
| 77 | + break;
|
|
| 78 | + }
|
|
| 79 | +}
|
|
| 40 | 80 | |
| 41 | 81 | #if defined(THREADED_RTS)
|
| 42 | 82 | static Mutex trace_utx;
|
| ... | ... | @@ -51,43 +91,41 @@ static void traceCap_stderr(Capability *cap, char *msg, ...); |
| 51 | 91 | --------------------------------------------------------------------------- */
|
| 52 | 92 | |
| 53 | 93 | /*
|
| 54 | - * Update the TRACE_* globals. Must be called whenever RtsFlags.TraceFlags is
|
|
| 55 | - * modified.
|
|
| 94 | + * Initialise the runtime trace flags from RtsFlags.TraceFlags.
|
|
| 56 | 95 | */
|
| 57 | -static void updateTraceFlagCache (void)
|
|
| 58 | -{
|
|
| 59 | - // -Ds turns on scheduler tracing too
|
|
| 60 | - TRACE_sched =
|
|
| 61 | - RtsFlags.TraceFlags.scheduler ||
|
|
| 62 | - RtsFlags.DebugFlags.scheduler;
|
|
| 63 | - |
|
| 64 | - // -Dg turns on gc tracing too
|
|
| 65 | - TRACE_gc =
|
|
| 66 | - RtsFlags.TraceFlags.gc ||
|
|
| 67 | - RtsFlags.DebugFlags.gc ||
|
|
| 68 | - RtsFlags.DebugFlags.scheduler;
|
|
| 69 | - |
|
| 70 | - TRACE_nonmoving_gc =
|
|
| 71 | - RtsFlags.TraceFlags.nonmoving_gc;
|
|
| 72 | - |
|
| 73 | - TRACE_spark_sampled =
|
|
| 74 | - RtsFlags.TraceFlags.sparks_sampled;
|
|
| 75 | - |
|
| 76 | - // -Dr turns on full spark tracing
|
|
| 77 | - TRACE_spark_full =
|
|
| 78 | - RtsFlags.TraceFlags.sparks_full ||
|
|
| 79 | - RtsFlags.DebugFlags.sparks;
|
|
| 80 | - |
|
| 81 | - TRACE_user =
|
|
| 82 | - RtsFlags.TraceFlags.user;
|
|
| 83 | - |
|
| 84 | - // We trace cap events if we're tracing anything else
|
|
| 85 | - TRACE_cap =
|
|
| 86 | - TRACE_sched ||
|
|
| 87 | - TRACE_gc ||
|
|
| 88 | - TRACE_spark_sampled ||
|
|
| 89 | - TRACE_spark_full ||
|
|
| 90 | - TRACE_user;
|
|
| 96 | +static void updateTraceFlagCache(void) {
|
|
| 97 | + // -Ds turns on scheduler tracing too
|
|
| 98 | + RuntimeTraceFlagCache.scheduler =
|
|
| 99 | + RtsFlags.TraceFlags.scheduler ||
|
|
| 100 | + RtsFlags.DebugFlags.scheduler;
|
|
| 101 | + |
|
| 102 | + // -Dg turns on gc tracing too
|
|
| 103 | + RuntimeTraceFlagCache.gc =
|
|
| 104 | + RtsFlags.TraceFlags.gc ||
|
|
| 105 | + RtsFlags.DebugFlags.gc ||
|
|
| 106 | + RtsFlags.DebugFlags.scheduler;
|
|
| 107 | + |
|
| 108 | + RuntimeTraceFlagCache.nonmoving_gc =
|
|
| 109 | + RtsFlags.TraceFlags.nonmoving_gc;
|
|
| 110 | + |
|
| 111 | + RuntimeTraceFlagCache.spark_sampled =
|
|
| 112 | + RtsFlags.TraceFlags.sparks_sampled;
|
|
| 113 | + |
|
| 114 | + // -Dr turns on full spark tracing
|
|
| 115 | + RuntimeTraceFlagCache.spark_full =
|
|
| 116 | + RtsFlags.TraceFlags.sparks_full ||
|
|
| 117 | + RtsFlags.DebugFlags.sparks;
|
|
| 118 | + |
|
| 119 | + RuntimeTraceFlagCache.user =
|
|
| 120 | + RtsFlags.TraceFlags.user;
|
|
| 121 | + |
|
| 122 | + // We trace cap events if we're tracing anything else
|
|
| 123 | + RuntimeTraceFlagCache.cap =
|
|
| 124 | + TRACE_sched ||
|
|
| 125 | + TRACE_gc ||
|
|
| 126 | + TRACE_spark_sampled ||
|
|
| 127 | + TRACE_spark_full ||
|
|
| 128 | + TRACE_user;
|
|
| 91 | 129 | }
|
| 92 | 130 | |
| 93 | 131 | void initTracing (void)
|
| ... | ... | @@ -880,59 +918,65 @@ void traceThreadLabel_(Capability *cap, |
| 880 | 918 | }
|
| 881 | 919 | }
|
| 882 | 920 | |
| 883 | -void traceConcMarkBegin(void)
|
|
| 921 | +void traceNonmovingGcEvent_ (EventTypeNum tag)
|
|
| 884 | 922 | {
|
| 885 | - if (eventlog_enabled)
|
|
| 886 | - postEventNoCap(EVENT_CONC_MARK_BEGIN);
|
|
| 923 | +#if defined(DEBUG)
|
|
| 924 | + if (RtsFlags.TraceFlags.tracing == TRACE_STDERR) {
|
|
| 925 | + /* nothing - no string representation for nonmoving GC events */
|
|
| 926 | + } else
|
|
| 927 | +#endif
|
|
| 928 | + {
|
|
| 929 | + /* currently most non-moving GC events are nullary events */
|
|
| 930 | + postEventNoCap(tag);
|
|
| 931 | + }
|
|
| 887 | 932 | }
|
| 888 | 933 | |
| 889 | -void traceConcMarkEnd(StgWord32 marked_obj_count)
|
|
| 934 | +void traceConcMarkEnd_(StgWord32 marked_obj_count)
|
|
| 890 | 935 | {
|
| 891 | - if (eventlog_enabled)
|
|
| 936 | +#if defined(DEBUG)
|
|
| 937 | + if (RtsFlags.TraceFlags.tracing == TRACE_STDERR) {
|
|
| 938 | + /* nothing - no string representation for nonmoving GC events */
|
|
| 939 | + } else
|
|
| 940 | +#endif
|
|
| 941 | + {
|
|
| 892 | 942 | postConcMarkEnd(marked_obj_count);
|
| 943 | + }
|
|
| 893 | 944 | }
|
| 894 | 945 | |
| 895 | -void traceConcSyncBegin(void)
|
|
| 896 | -{
|
|
| 897 | - if (eventlog_enabled)
|
|
| 898 | - postEventNoCap(EVENT_CONC_SYNC_BEGIN);
|
|
| 899 | -}
|
|
| 900 | - |
|
| 901 | -void traceConcSyncEnd(void)
|
|
| 902 | -{
|
|
| 903 | - if (eventlog_enabled)
|
|
| 904 | - postEventNoCap(EVENT_CONC_SYNC_END);
|
|
| 905 | -}
|
|
| 906 | - |
|
| 907 | -void traceConcSweepBegin(void)
|
|
| 908 | -{
|
|
| 909 | - if (eventlog_enabled)
|
|
| 910 | - postEventNoCap(EVENT_CONC_SWEEP_BEGIN);
|
|
| 911 | -}
|
|
| 912 | - |
|
| 913 | -void traceConcSweepEnd(void)
|
|
| 914 | -{
|
|
| 915 | - if (eventlog_enabled)
|
|
| 916 | - postEventNoCap(EVENT_CONC_SWEEP_END);
|
|
| 917 | -}
|
|
| 918 | - |
|
| 919 | -void traceConcUpdRemSetFlush(Capability *cap)
|
|
| 946 | +void traceConcUpdRemSetFlush_(Capability *cap)
|
|
| 920 | 947 | {
|
| 921 | - if (eventlog_enabled)
|
|
| 948 | +#if defined(DEBUG)
|
|
| 949 | + if (RtsFlags.TraceFlags.tracing == TRACE_STDERR) {
|
|
| 950 | + /* nothing - no string representation for nonmoving GC events */
|
|
| 951 | + } else
|
|
| 952 | +#endif
|
|
| 953 | + {
|
|
| 922 | 954 | postConcUpdRemSetFlush(cap);
|
| 955 | + }
|
|
| 923 | 956 | }
|
| 924 | 957 | |
| 925 | -void traceNonmovingHeapCensus(uint16_t blk_size,
|
|
| 926 | - const struct NonmovingAllocCensus *census)
|
|
| 958 | +void traceNonmovingHeapCensus_(uint16_t blk_size, const struct NonmovingAllocCensus *census)
|
|
| 927 | 959 | {
|
| 928 | - if (eventlog_enabled && TRACE_nonmoving_gc)
|
|
| 960 | +#if defined(DEBUG)
|
|
| 961 | + if (RtsFlags.TraceFlags.tracing == TRACE_STDERR) {
|
|
| 962 | + /* nothing - no string representation for nonmoving GC events */
|
|
| 963 | + } else
|
|
| 964 | +#endif
|
|
| 965 | + {
|
|
| 929 | 966 | postNonmovingHeapCensus(blk_size, census);
|
| 967 | + }
|
|
| 930 | 968 | }
|
| 931 | 969 | |
| 932 | -void traceNonmovingPrunedSegments(uint32_t pruned_segments, uint32_t free_segments)
|
|
| 970 | +void traceNonmovingPrunedSegments_(uint32_t pruned_segments, uint32_t free_segments)
|
|
| 933 | 971 | {
|
| 934 | - if (eventlog_enabled && TRACE_nonmoving_gc)
|
|
| 972 | +#if defined(DEBUG)
|
|
| 973 | + if (RtsFlags.TraceFlags.tracing == TRACE_STDERR) {
|
|
| 974 | + /* nothing - no string representation for nonmoving GC events */
|
|
| 975 | + } else
|
|
| 976 | +#endif
|
|
| 977 | + {
|
|
| 935 | 978 | postNonmovingPrunedSegments(pruned_segments, free_segments);
|
| 979 | + }
|
|
| 936 | 980 | }
|
| 937 | 981 | |
| 938 | 982 | void traceThreadStatus_ (StgTSO *tso USED_IF_DEBUG)
|
| ... | ... | @@ -70,16 +70,35 @@ enum CapsetType { CapsetTypeCustom = CAPSET_TYPE_CUSTOM, |
| 70 | 70 | #define DEBUG_continuation RtsFlags.DebugFlags.continuation
|
| 71 | 71 | #define DEBUG_iomanager RtsFlags.DebugFlags.iomanager
|
| 72 | 72 | |
| 73 | -// Event-enabled flags
|
|
| 74 | -// These semantically booleans but we use a dense packing to minimize their
|
|
| 75 | -// cache impact.
|
|
| 76 | -extern uint8_t TRACE_sched;
|
|
| 77 | -extern uint8_t TRACE_gc;
|
|
| 78 | -extern uint8_t TRACE_nonmoving_gc;
|
|
| 79 | -extern uint8_t TRACE_spark_sampled;
|
|
| 80 | -extern uint8_t TRACE_spark_full;
|
|
| 81 | -extern uint8_t TRACE_cap;
|
|
| 82 | -/* extern uint8_t TRACE_user; */ // only used in Trace.c
|
|
| 73 | +// These trace flags are shorthand for the members of the RuntimeTraceFlagCache
|
|
| 74 | +// struct. Within the RTS, these should be treated as read-only variables.
|
|
| 75 | +#define TRACE_sched ((const bool)RuntimeTraceFlagCache.scheduler)
|
|
| 76 | +#define TRACE_gc ((const bool)RuntimeTraceFlagCache.gc)
|
|
| 77 | +#define TRACE_nonmoving_gc ((const bool)RuntimeTraceFlagCache.nonmoving_gc)
|
|
| 78 | +#define TRACE_spark_sampled ((const bool)RuntimeTraceFlagCache.spark_sampled)
|
|
| 79 | +#define TRACE_spark_full ((const bool)RuntimeTraceFlagCache.spark_full)
|
|
| 80 | +#define TRACE_user ((const bool)RuntimeTraceFlagCache.user)
|
|
| 81 | +#define TRACE_cap ((const bool)RuntimeTraceFlagCache.cap)
|
|
| 82 | + |
|
| 83 | +/*
|
|
| 84 | + * Runtime trace flags.
|
|
| 85 | + */
|
|
| 86 | +typedef struct {
|
|
| 87 | + bool scheduler;
|
|
| 88 | + bool gc;
|
|
| 89 | + bool nonmoving_gc;
|
|
| 90 | + bool spark_sampled;
|
|
| 91 | + bool spark_full;
|
|
| 92 | + bool user;
|
|
| 93 | + bool cap;
|
|
| 94 | +} RUNTIME_TRACE_FLAG_CACHE;
|
|
| 95 | + |
|
| 96 | +/*
|
|
| 97 | + * These flags should be used to determine whether or not some value should
|
|
| 98 | + * be traced at runtime, rather than the values in RtsFlags. These flags can
|
|
| 99 | + * be modified at runtime using setTraceFlag in `rts/EventLogWriter.h`.
|
|
| 100 | + */
|
|
| 101 | +extern RUNTIME_TRACE_FLAG_CACHE RuntimeTraceFlagCache;
|
|
| 83 | 102 | |
| 84 | 103 | // -----------------------------------------------------------------------------
|
| 85 | 104 | // Posting events
|
| ... | ... | @@ -136,6 +155,52 @@ void traceGcEvent_ (Capability *cap, EventTypeNum tag); |
| 136 | 155 | |
| 137 | 156 | void traceGcEventAtT_ (Capability *cap, StgWord64 ts, EventTypeNum tag);
|
| 138 | 157 | |
| 158 | +/*
|
|
| 159 | + * Record a nonmoving GC event.
|
|
| 160 | + */
|
|
| 161 | +#define traceConcMarkBegin() \
|
|
| 162 | + if (RTS_UNLIKELY(TRACE_nonmoving_gc)) { \
|
|
| 163 | + traceNonmovingGcEvent_(EVENT_CONC_MARK_BEGIN); \
|
|
| 164 | + }
|
|
| 165 | +#define traceConcMarkEnd(marked_obj_count) \
|
|
| 166 | + if (RTS_UNLIKELY(TRACE_nonmoving_gc)) { \
|
|
| 167 | + traceConcMarkEnd_(marked_obj_count); \
|
|
| 168 | + }
|
|
| 169 | +#define traceConcSyncBegin() \
|
|
| 170 | + if (RTS_UNLIKELY(TRACE_nonmoving_gc)) { \
|
|
| 171 | + traceNonmovingGcEvent_(EVENT_CONC_SYNC_BEGIN); \
|
|
| 172 | + }
|
|
| 173 | +#define traceConcSyncEnd() \
|
|
| 174 | + if (RTS_UNLIKELY(TRACE_nonmoving_gc)) { \
|
|
| 175 | + traceNonmovingGcEvent_(EVENT_CONC_SYNC_END); \
|
|
| 176 | + }
|
|
| 177 | +#define traceConcSweepBegin() \
|
|
| 178 | + if (RTS_UNLIKELY(TRACE_nonmoving_gc)) { \
|
|
| 179 | + traceNonmovingGcEvent_(EVENT_CONC_SWEEP_BEGIN); \
|
|
| 180 | + }
|
|
| 181 | +#define traceConcSweepEnd() \
|
|
| 182 | + if (RTS_UNLIKELY(TRACE_nonmoving_gc)) { \
|
|
| 183 | + traceNonmovingGcEvent_(EVENT_CONC_SWEEP_END); \
|
|
| 184 | + }
|
|
| 185 | +#define traceConcUpdRemSetFlush(cap) \
|
|
| 186 | + if (RTS_UNLIKELY(TRACE_nonmoving_gc)) { \
|
|
| 187 | + traceConcUpdRemSetFlush_(cap); \
|
|
| 188 | + }
|
|
| 189 | +#define traceNonmovingHeapCensus(blk_size, census) \
|
|
| 190 | + if (RTS_UNLIKELY(TRACE_nonmoving_gc)) { \
|
|
| 191 | + traceNonmovingHeapCensus_(blk_size, census); \
|
|
| 192 | + }
|
|
| 193 | +#define traceNonmovingPrunedSegments(pruned_segments, free_segments) \
|
|
| 194 | + if (RTS_UNLIKELY(TRACE_nonmoving_gc)) { \
|
|
| 195 | + traceNonmovingPrunedSegments_(pruned_segments, free_segments); \
|
|
| 196 | + }
|
|
| 197 | + |
|
| 198 | +void traceNonmovingGcEvent_ (EventTypeNum tag);
|
|
| 199 | +void traceConcMarkEnd_(StgWord32 marked_obj_count);
|
|
| 200 | +void traceConcUpdRemSetFlush_(Capability *cap);
|
|
| 201 | +void traceNonmovingHeapCensus_(uint16_t blk_size, const struct NonmovingAllocCensus *census);
|
|
| 202 | +void traceNonmovingPrunedSegments_(uint32_t pruned_segments, uint32_t free_segments);
|
|
| 203 | + |
|
| 139 | 204 | /*
|
| 140 | 205 | * Record a heap event
|
| 141 | 206 | */
|
| ... | ... | @@ -321,17 +386,6 @@ void traceProfSampleCostCentre(Capability *cap, |
| 321 | 386 | void traceProfBegin(void);
|
| 322 | 387 | #endif /* PROFILING */
|
| 323 | 388 | |
| 324 | -void traceConcMarkBegin(void);
|
|
| 325 | -void traceConcMarkEnd(StgWord32 marked_obj_count);
|
|
| 326 | -void traceConcSyncBegin(void);
|
|
| 327 | -void traceConcSyncEnd(void);
|
|
| 328 | -void traceConcSweepBegin(void);
|
|
| 329 | -void traceConcSweepEnd(void);
|
|
| 330 | -void traceConcUpdRemSetFlush(Capability *cap);
|
|
| 331 | -void traceNonmovingHeapCensus(uint16_t blk_size,
|
|
| 332 | - const struct NonmovingAllocCensus *census);
|
|
| 333 | -void traceNonmovingPrunedSegments(uint32_t pruned_segments, uint32_t free_segments);
|
|
| 334 | - |
|
| 335 | 389 | void traceIPE(const InfoProvEnt *ipe);
|
| 336 | 390 | void flushTrace(void);
|
| 337 | 391 | |
| ... | ... | @@ -384,6 +438,7 @@ void flushTrace(void); |
| 384 | 438 | #define traceConcSweepEnd() /* nothing */
|
| 385 | 439 | #define traceConcUpdRemSetFlush(cap) /* nothing */
|
| 386 | 440 | #define traceNonmovingHeapCensus(blk_size, census) /* nothing */
|
| 441 | +#define traceNonmovingPrunedSegments(pruned_segments, free_segments) /* nothing */
|
|
| 387 | 442 | |
| 388 | 443 | #define flushTrace() /* nothing */
|
| 389 | 444 |
| ... | ... | @@ -78,3 +78,34 @@ void endEventLogging(void); |
| 78 | 78 | * Flush the eventlog. cap can be NULL if one is not held.
|
| 79 | 79 | */
|
| 80 | 80 | void flushEventLog(Capability **cap);
|
| 81 | + |
|
| 82 | +/*
|
|
| 83 | + * An enumeration for the runtime trace flags.
|
|
| 84 | + */
|
|
| 85 | +typedef enum {
|
|
| 86 | + TRACE_SCHEDULER,
|
|
| 87 | + TRACE_GC,
|
|
| 88 | + TRACE_NONMOVING_GC,
|
|
| 89 | + TRACE_SPARK_SAMPLED,
|
|
| 90 | + TRACE_SPARK_FULL,
|
|
| 91 | + TRACE_USER,
|
|
| 92 | + TRACE_CAP,
|
|
| 93 | +} RUNTIME_TRACE_FLAG;
|
|
| 94 | + |
|
| 95 | +/*
|
|
| 96 | + * Get the value of the given runtime trace flag.
|
|
| 97 | + *
|
|
| 98 | + * Warning: The trace flag cache is not thread-safe. After initialisation, the
|
|
| 99 | + * RTS never writes to these values, but concurrently using getTraceFlag and
|
|
| 100 | + * setTraceFlag for the same flag is a race condition.
|
|
| 101 | + */
|
|
| 102 | +bool getTraceFlag(RUNTIME_TRACE_FLAG flag);
|
|
| 103 | + |
|
| 104 | +/*
|
|
| 105 | + * Set the value of the given runtime trace flag.
|
|
| 106 | + *
|
|
| 107 | + * Warning: The trace flag cache is not thread-safe. After initialisation, the
|
|
| 108 | + * RTS never writes to these values. However, inconsistent reads may lead to
|
|
| 109 | + * incorrect tracing for a short time after setting a trace flag.
|
|
| 110 | + */
|
|
| 111 | +void setTraceFlag(RUNTIME_TRACE_FLAG flag, bool value); |
| ... | ... | @@ -76,18 +76,6 @@ |
| 76 | 76 | *
|
| 77 | 77 | * See bug #781
|
| 78 | 78 | * See thread http://www.haskell.org/pipermail/cvs-ghc/2007-September/038458.html
|
| 79 | - *
|
|
| 80 | - * Naming Scheme for Symbol Macros
|
|
| 81 | - *
|
|
| 82 | - * SymI_*: symbol is internal to the RTS. It resides in an object
|
|
| 83 | - * file/library that is statically.
|
|
| 84 | - * SymE_*: symbol is external to the RTS library. It might be linked
|
|
| 85 | - * dynamically.
|
|
| 86 | - *
|
|
| 87 | - * Sym*_HasProto : the symbol prototype is imported in an include file
|
|
| 88 | - * or defined explicitly
|
|
| 89 | - * Sym*_NeedsProto: the symbol is undefined and we add a dummy
|
|
| 90 | - * default proto extern void sym(void);
|
|
| 91 | 79 | */
|
| 92 | 80 | #define X86_64_ELF_NONPIC_HACK (!RtsFlags.MiscFlags.linkerAlwaysPic)
|
| 93 | 81 |
| 1 | +/* -----------------------------------------------------------------------------
|
|
| 2 | + *
|
|
| 3 | + * (c) The GHC Team 2025
|
|
| 4 | + *
|
|
| 5 | + * Utilities for a simple fd-based cross-thread wakeup mechanism.
|
|
| 6 | + *
|
|
| 7 | + * This is used to provide a mechanism to wake a thread when it is blocked
|
|
| 8 | + * waiting on fds and timeouts. The mechanism works by including the read end
|
|
| 9 | + * fd into the set of fds the thread waits on, and when a wake up is needed,
|
|
| 10 | + * the write end fd is used.
|
|
| 11 | + *
|
|
| 12 | + * This is implemented using either eventfd() or pipe().
|
|
| 13 | + *
|
|
| 14 | + * Linux 2.6.22+ and FreeBSD 13+ support eventfd. It is a single fd with a
|
|
| 15 | + * 64bit counter. It uses fewer resources than a pipe (less memory and one
|
|
| 16 | + * rather than two fds), and is a tad faster (on the order of 5-10%). Using
|
|
| 17 | + * write() adds to the counter, while read() reads and resets it. Thus
|
|
| 18 | + * multiple writes are combined automatically into a single corresponding
|
|
| 19 | + * read.
|
|
| 20 | + *
|
|
| 21 | + * Otherwise we use a classic unix pipe.
|
|
| 22 | + *
|
|
| 23 | + * In both implementations, multiple sendFdWakeup notifcations (without
|
|
| 24 | + * interleaved collectFdWakeup) are combined to a single notification. This
|
|
| 25 | + * is automatic given the semantics of eventfd, while for pipe we implement
|
|
| 26 | + * it explicitly by draining the pipe in collectFdWakeup.
|
|
| 27 | + *
|
|
| 28 | + * -------------------------------------------------------------------------*/
|
|
| 29 | + |
|
| 30 | +#include "rts/PosixSource.h"
|
|
| 31 | +#include "Rts.h"
|
|
| 32 | + |
|
| 33 | +#include "FdWakeup.h"
|
|
| 34 | + |
|
| 35 | +#include <fcntl.h>
|
|
| 36 | +#include <unistd.h>
|
|
| 37 | + |
|
| 38 | +#ifdef HAVE_SYS_EVENTFD_H
|
|
| 39 | +#include <sys/eventfd.h>
|
|
| 40 | +#endif
|
|
| 41 | + |
|
| 42 | +#if !defined(HAVE_EVENTFD) \
|
|
| 43 | + || (defined(HAVE_EVENTFD) && !(defined(EFD_CLOEXEC) && defined(EFD_NONBLOCK)))
|
|
| 44 | +static void fcntl_CLOEXEC_NONBLOCK(int fd)
|
|
| 45 | +{
|
|
| 46 | + int res1 = fcntl(fd, F_SETFD, FD_CLOEXEC);
|
|
| 47 | + int res2 = fcntl(fd, F_SETFL, O_NONBLOCK);
|
|
| 48 | + if (RTS_UNLIKELY(res1 < 0 || res2 < 0)) {
|
|
| 49 | + sysErrorBelch("newFdWakeup fcntl()");
|
|
| 50 | + stg_exit(EXIT_FAILURE);
|
|
| 51 | + }
|
|
| 52 | +}
|
|
| 53 | +#endif
|
|
| 54 | + |
|
| 55 | +void newFdWakeup(int *wakeup_fd_r, int *wakeup_fd_w)
|
|
| 56 | +{
|
|
| 57 | +#if defined(HAVE_EVENTFD)
|
|
| 58 | + int wakeup_fd;
|
|
| 59 | +#if defined(EFD_CLOEXEC) && defined(EFD_NONBLOCK)
|
|
| 60 | + wakeup_fd = eventfd(0, EFD_CLOEXEC | EFD_NONBLOCK);
|
|
| 61 | +#else
|
|
| 62 | + wakeup_fd = eventfd(0, 0);
|
|
| 63 | + if (wakeup_fd >= 0) fcntl_CLOEXEC_NONBLOCK(wakeup_fd);
|
|
| 64 | +#endif
|
|
| 65 | + if (RTS_UNLIKELY(wakeup_fd < 0)) {
|
|
| 66 | + sysErrorBelch("newFdWakeup eventfd()");
|
|
| 67 | + stg_exit(EXIT_FAILURE);
|
|
| 68 | + }
|
|
| 69 | + /* eventfd uses the same fd for each end */
|
|
| 70 | + *wakeup_fd_r = wakeup_fd;
|
|
| 71 | + *wakeup_fd_w = wakeup_fd;
|
|
| 72 | +#else
|
|
| 73 | + int pipefd[2];
|
|
| 74 | + int res;
|
|
| 75 | + res = pipe(pipefd);
|
|
| 76 | + if (RTS_UNLIKELY(res < 0)) {
|
|
| 77 | + sysErrorBelch("newFdWakeup pipe");
|
|
| 78 | + stg_exit(EXIT_FAILURE);
|
|
| 79 | + }
|
|
| 80 | + fcntl_CLOEXEC_NONBLOCK(pipefd[0]);
|
|
| 81 | + fcntl_CLOEXEC_NONBLOCK(pipefd[1]);
|
|
| 82 | + *wakeup_fd_r = pipefd[0]; /* read end */
|
|
| 83 | + *wakeup_fd_w = pipefd[1]; /* write end */
|
|
| 84 | +#endif
|
|
| 85 | +}
|
|
| 86 | + |
|
| 87 | +void closeFdWakeup(int wakeup_fd_r, int wakeup_fd_w)
|
|
| 88 | +{
|
|
| 89 | +#if defined(HAVE_EVENTFD)
|
|
| 90 | + ASSERT(wakeup_fd_r == wakeup_fd_w);
|
|
| 91 | + close(wakeup_fd_r);
|
|
| 92 | +#else
|
|
| 93 | + ASSERT(wakeup_fd_r != wakeup_fd_w);
|
|
| 94 | + close(wakeup_fd_r);
|
|
| 95 | + close(wakeup_fd_w);
|
|
| 96 | +#endif
|
|
| 97 | +}
|
|
| 98 | + |
|
| 99 | +/* This is safe to use from a signal handler. Using write() to a pipe
|
|
| 100 | + * or eventfd is fine. */
|
|
| 101 | +void sendFdWakeup(int wakeup_fd_w)
|
|
| 102 | +{
|
|
| 103 | + int res;
|
|
| 104 | +#if defined(HAVE_EVENTFD)
|
|
| 105 | + uint64_t val = 1;
|
|
| 106 | + res = write(wakeup_fd_w, &val, 8);
|
|
| 107 | +#else
|
|
| 108 | + unsigned char buf = 1;
|
|
| 109 | + res = write(wakeup_fd_w, &buf, 1);
|
|
| 110 | +#endif
|
|
| 111 | + if (RTS_UNLIKELY(res < 0)) {
|
|
| 112 | + /* Unlikely the pipe buffer will fill, but it would not be an error. */
|
|
| 113 | + if (errno == EAGAIN) return;
|
|
| 114 | + sysErrorBelch("sendFdWakeup write");
|
|
| 115 | + stg_exit(EXIT_FAILURE);
|
|
| 116 | + }
|
|
| 117 | +}
|
|
| 118 | + |
|
| 119 | +void collectFdWakeup(int wakeup_fd_r)
|
|
| 120 | +{
|
|
| 121 | + int res;
|
|
| 122 | +#if defined(HAVE_EVENTFD)
|
|
| 123 | + uint64_t buf;
|
|
| 124 | + /* eventfd combines events into one counter, so a single read is enough */
|
|
| 125 | + res = read(wakeup_fd_r, &buf, 8);
|
|
| 126 | +#else
|
|
| 127 | + /* Drain the pipe buffer. Multiple wakeup notifications could
|
|
| 128 | + * have been sent before we have a chance to collect them.
|
|
| 129 | + */
|
|
| 130 | + uint64_t buf;
|
|
| 131 | + do {
|
|
| 132 | + res = read(wakeup_fd_r, &buf, 8);
|
|
| 133 | + } while (res == 8);
|
|
| 134 | +#endif
|
|
| 135 | + if (RTS_UNLIKELY(res < 0)) {
|
|
| 136 | + /* After the first pipe read, it could block */
|
|
| 137 | + if (errno == EAGAIN) return;
|
|
| 138 | + sysErrorBelch("collectFdWakeup read");
|
|
| 139 | + stg_exit(EXIT_FAILURE);
|
|
| 140 | + }
|
|
| 141 | +} |
| 1 | +/* -----------------------------------------------------------------------------
|
|
| 2 | + *
|
|
| 3 | + * (c) The GHC Team 2025
|
|
| 4 | + *
|
|
| 5 | + * Utilities for a simple fd-based cross-thread wakeup mechanism.
|
|
| 6 | + *
|
|
| 7 | + * It provides a mechanism for a thread that block on fds to add a simple
|
|
| 8 | + * wakeup/notification feature.
|
|
| 9 | + *
|
|
| 10 | + * Start with newFdWakeup, and pass the fd_r to the thread that needs the
|
|
| 11 | + * wakeup feature. The thread that needs to be woken should include the fd_r
|
|
| 12 | + * into the set of fds that the thread waits on (e.g. using poll or similar).
|
|
| 13 | + * If this fd becomes ready for read, the thread must call collectFdWakeup,
|
|
| 14 | + * and when a wake up is needed, the write end fd is used. In any other thread
|
|
| 15 | + * (or in a signal handler), call sendFdWakeup(fd_w) to (asynchronously) cause
|
|
| 16 | + * the wakeup.
|
|
| 17 | + *
|
|
| 18 | + * There is no message payload. Multiple wakeups may be combined (if they're
|
|
| 19 | + * sent multiple times before the notified thread can wake and call
|
|
| 20 | + * collectFdWakeup).
|
|
| 21 | + *
|
|
| 22 | + * The implementation uses pipe() or eventfd() on supported OSs.
|
|
| 23 | + *
|
|
| 24 | + * Prototypes for functions in FdWakeup.c
|
|
| 25 | + *
|
|
| 26 | + * -------------------------------------------------------------------------*/
|
|
| 27 | + |
|
| 28 | +#pragma once
|
|
| 29 | + |
|
| 30 | +#include "BeginPrivate.h"
|
|
| 31 | + |
|
| 32 | +void newFdWakeup(int *fd_r, int *fd_w);
|
|
| 33 | +void closeFdWakeup(int fd_r, int fd_w);
|
|
| 34 | + |
|
| 35 | +/* This is safe to use from a signal handler */
|
|
| 36 | +void sendFdWakeup(int fd_w);
|
|
| 37 | +void collectFdWakeup(int fd_r);
|
|
| 38 | + |
|
| 39 | +#include "EndPrivate.h"
|
|
| 40 | + |
| 1 | 1 | /* -----------------------------------------------------------------------------
|
| 2 | 2 | *
|
| 3 | - * (c) The GHC Team, 1995-2007
|
|
| 3 | + * (c) The GHC Team, 1995-2026
|
|
| 4 | 4 | *
|
| 5 | - * Posix implementation(s) of the interval timer for profiling and pre-emptive
|
|
| 6 | - * scheduling.
|
|
| 5 | + * The posix implementation of the interval timer, used for pre-emptive
|
|
| 6 | + * scheduling of Haskell threads, and for sample based profiling.
|
|
| 7 | + *
|
|
| 8 | + * This file defines the "ticker": the platform-specific service to install and
|
|
| 9 | + * run the timer. See rts/Timer.c for the platform-dependent view of interval
|
|
| 10 | + * timing.
|
|
| 7 | 11 | *
|
| 8 | 12 | * ---------------------------------------------------------------------------*/
|
| 9 | 13 | |
| 10 | -/* The interval timer is used for profiling and for context switching.
|
|
| 11 | - * This file defines the platform-specific services to install and run the
|
|
| 12 | - * timers, and we call this the ticker. See rts/Timer.c for the
|
|
| 13 | - * platform-dependent view of interval timing.
|
|
| 14 | +/* This implementation uses a posix thread which repeatedly blocks on a timeout
|
|
| 15 | + * using either the ppoll() or select() API. This lets it also block on a file
|
|
| 16 | + * descriptor for early wakeup.
|
|
| 17 | + *
|
|
| 18 | + * The design uses a simple relative time delay with no catchup. That is, time
|
|
| 19 | + * spent by the ticker thread itself (e.g. flushing eventlog buffers) is not
|
|
| 20 | + * accounted for, and the next tick is delayed by that much (modulo wakeup
|
|
| 21 | + * jitter). This is probably the right thing to do: generally in realtime
|
|
| 22 | + * systems one does not want to try to catch up when behind, since that tends
|
|
| 23 | + * towards oversubscribing resources. Graceful degredation is usually
|
|
| 24 | + * preferable.
|
|
| 25 | + *
|
|
| 26 | + * Experimental results (on Linux 6.18 on x86-64) to measure the typical
|
|
| 27 | + * difference between the requested wakeup time and actual wakeup time for
|
|
| 28 | + * different delay intervals:
|
|
| 29 | + *
|
|
| 30 | + * interval typical actual wakeup time after due time
|
|
| 31 | + * 10000us 340 -- 400us (this is the default interval)
|
|
| 32 | + * 1000us 55 -- 100us
|
|
| 33 | + * 100us 55us
|
|
| 34 | + * 10us 55us
|
|
| 35 | + *
|
|
| 36 | + * While there's quite a bit of variance to these numbers, the results do not
|
|
| 37 | + * vary significantly between using select, ppoll or nanosleep.
|
|
| 38 | + *
|
|
| 39 | + * On Linux at least, for longer delays the kernel allows itself lower wakeup
|
|
| 40 | + * accuracy (which allows it to save power by coalescing multiple wakeups).
|
|
| 41 | + * Similarly, the reason for 55us on the low end is that the default thread
|
|
| 42 | + * timer slack on Linux is 50us, and context switch time accounts for the
|
|
| 43 | + * remainder.
|
|
| 44 | + *
|
|
| 45 | + * In conclusion, on Linux at least, the accuracy is fine, both for the
|
|
| 46 | + * default interval (10ms, 10000us) and for shorter intervals used during
|
|
| 47 | + * profiling.
|
|
| 14 | 48 | *
|
| 15 | 49 | * Historically we had ticker implementations using signals. This was always a
|
| 16 | - * rather shakey thing to do but we had few alternatives.
|
|
| 50 | + * rather shakey thing to do but we originally had few alternatives.
|
|
| 17 | 51 | * - One problem with using signals is that there are severe limits on what
|
| 18 | 52 | * code can be called from signal handlers. In particular it's not possible
|
| 19 | 53 | * to take locks in a signal handler contex. This was enough for contex
|
| ... | ... | @@ -23,17 +57,245 @@ |
| 23 | 57 | * calls (#10840) or can be overwritten by user code.
|
| 24 | 58 | */
|
| 25 | 59 | |
| 26 | -/* Select a ticker implementation to use:
|
|
| 27 | - *
|
|
| 28 | - * On modern Linux, FreeBSD and NetBSD we can use timerfd_create and a thread
|
|
| 29 | - * that waits on it using poll. Linux has had timerfd since version 2.6.25.
|
|
| 30 | - * NetBSD has had timerfd since version 10, and FreeBSD since version 15.
|
|
| 31 | - *
|
|
| 32 | - * For older version of linux/bsd without timerfd, and for all other posix
|
|
| 33 | - * platforms, we use the implementation using posix pthreads and nanosleep().
|
|
| 60 | +#include "rts/PosixSource.h"
|
|
| 61 | +#include "Rts.h"
|
|
| 62 | + |
|
| 63 | +#include "Ticker.h"
|
|
| 64 | +#include "RtsUtils.h"
|
|
| 65 | +#include "Proftimer.h"
|
|
| 66 | +#include "Schedule.h"
|
|
| 67 | +#include "posix/Clock.h"
|
|
| 68 | +#include "posix/FdWakeup.h"
|
|
| 69 | + |
|
| 70 | +#if defined(HAVE_DECL_PPOLL) && HAVE_DECL_PPOLL == 1
|
|
| 71 | +/* We prefer the ppoll() function if available since it allows sanely waiting
|
|
| 72 | + * on a single fd with precise timeouts (nanosecond precision). It is not in
|
|
| 73 | + * the posix standard however and some platforms (notably glibc and freebsd)
|
|
| 74 | + * need special CPP defines to make it available:
|
|
| 75 | + */
|
|
| 76 | +#define _GNU_SOURCE 1
|
|
| 77 | +#define __BSD_VISIBLE 1
|
|
| 78 | +#include <signal.h>
|
|
| 79 | +#include <poll.h>
|
|
| 80 | +#else
|
|
| 81 | +/* Otherwise we use the classic select(), which does have microsecond
|
|
| 82 | + * precision, but requires we build three whole 1024 bit (128 byte) fd sets
|
|
| 83 | + * just to wait on one fd.
|
|
| 34 | 84 | */
|
| 35 | -#if defined(HAVE_SYS_TIMERFD_H)
|
|
| 36 | -#include "ticker/TimerFd.c"
|
|
| 85 | +#include <sys/select.h>
|
|
| 86 | +#endif
|
|
| 87 | + |
|
| 88 | +#include <time.h>
|
|
| 89 | +#if HAVE_SYS_TIME_H
|
|
| 90 | +# include <sys/time.h>
|
|
| 91 | +#endif
|
|
| 92 | + |
|
| 93 | +#if defined(HAVE_SIGNAL_H)
|
|
| 94 | +# include <signal.h>
|
|
| 95 | +#endif
|
|
| 96 | + |
|
| 97 | +#include <string.h>
|
|
| 98 | + |
|
| 99 | +#include <pthread.h>
|
|
| 100 | +#if defined(HAVE_PTHREAD_NP_H)
|
|
| 101 | +#include <pthread_np.h>
|
|
| 102 | +#endif
|
|
| 103 | +#include <unistd.h>
|
|
| 104 | +#include <fcntl.h>
|
|
| 105 | + |
|
| 106 | +static Time itimer_interval = DEFAULT_TICK_INTERVAL;
|
|
| 107 | + |
|
| 108 | +// Should we be firing ticks?
|
|
| 109 | +// Writers to this must hold the mutex below.
|
|
| 110 | +static bool stopped = false;
|
|
| 111 | + |
|
| 112 | +// should the ticker thread exit?
|
|
| 113 | +// This can be set without holding the mutex.
|
|
| 114 | +static bool exited = true;
|
|
| 115 | + |
|
| 116 | +// Signaled when we want to (re)start the timer
|
|
| 117 | +static Condition start_cond;
|
|
| 118 | +static Mutex mutex;
|
|
| 119 | +static OSThreadId thread;
|
|
| 120 | + |
|
| 121 | +// fds for interrupting the ticker
|
|
| 122 | +static int interruptfd_r = -1, interruptfd_w = -1;
|
|
| 123 | + |
|
| 124 | +static void *itimer_thread_func(void *_handle_tick)
|
|
| 125 | +{
|
|
| 126 | + TickProc handle_tick = _handle_tick;
|
|
| 127 | + |
|
| 128 | +#if defined(HAVE_DECL_PPOLL) && HAVE_DECL_PPOLL == 1
|
|
| 129 | + struct pollfd pollfds[1];
|
|
| 130 | + |
|
| 131 | + pollfds[0].fd = interruptfd_r;
|
|
| 132 | + pollfds[0].events = POLLIN;
|
|
| 133 | + |
|
| 134 | + struct timespec ts = { .tv_sec = TimeToSeconds(itimer_interval)
|
|
| 135 | + , .tv_nsec = TimeToNS(itimer_interval) % 1000000000
|
|
| 136 | + };
|
|
| 37 | 137 | #else
|
| 38 | -#include "ticker/Pthread.c"
|
|
| 138 | + fd_set selectfds;
|
|
| 139 | + FD_ZERO(&selectfds);
|
|
| 140 | + FD_SET(interruptfd_r, &selectfds);
|
|
| 141 | + |
|
| 142 | + struct timeval tv = { .tv_sec = TimeToSeconds(itimer_interval)
|
|
| 143 | + /* convert remainder time in nanoseconds
|
|
| 144 | + to microseconds, rounding up: */
|
|
| 145 | + , .tv_usec = ((TimeToNS(itimer_interval) % 1000000000)
|
|
| 146 | + + 999) / 1000
|
|
| 147 | + };
|
|
| 148 | +#endif
|
|
| 149 | + |
|
| 150 | + // Relaxed is sufficient: If we don't see that exited was set in one iteration we will
|
|
| 151 | + // see it next time.
|
|
| 152 | + while (!RELAXED_LOAD_ALWAYS(&exited)) {
|
|
| 153 | + |
|
| 154 | +#if defined(HAVE_DECL_PPOLL) && HAVE_DECL_PPOLL == 1
|
|
| 155 | + int nfds = 1;
|
|
| 156 | + int nready = ppoll(pollfds, nfds, &ts, NULL);
|
|
| 157 | +#else
|
|
| 158 | + struct timeval tv_tmp = tv; // copy since select may change this value.
|
|
| 159 | + int nfds = interruptfd_r+1;
|
|
| 160 | + int nready = select(nfds, &selectfds, NULL, NULL, &tv_tmp);
|
|
| 161 | +#endif
|
|
| 162 | + // In either case (ppoll or select), the result nready is the number
|
|
| 163 | + // of fds that are ready.
|
|
| 164 | + if (RTS_LIKELY(nready == 0)) {
|
|
| 165 | + // Timer expired, not interrupted, continue.
|
|
| 166 | + } else if (nready > 0) {
|
|
| 167 | + // We only monitor one fd (the interruptfd_r), so we know
|
|
| 168 | + // it is that fd that is ready without any further checks.
|
|
| 169 | + collectFdWakeup(interruptfd_r);
|
|
| 170 | + // No further action needed, continue on to handling the final tick
|
|
| 171 | + // and then stop.
|
|
| 172 | + |
|
| 173 | + // Note that we rely on sendFdWakeup and select/poll to provide the
|
|
| 174 | + // happens-before relation. So if 'exited' was set before calling
|
|
| 175 | + // sendFdWakeup, then we should be able to reliably read it after.
|
|
| 176 | + // And thus reading 'exited' in the while loop guard is ok.
|
|
| 177 | + } else {
|
|
| 178 | + // While the RTS attempts to mask signals, some foreign libraries
|
|
| 179 | + // that rely on signal delivery may unmask them. Consequently we
|
|
| 180 | + // may see EINTR. See #24610.
|
|
| 181 | + if (errno != EINTR) {
|
|
| 182 | + sysErrorBelch("Ticker: poll failed: %s", strerror(errno));
|
|
| 183 | + }
|
|
| 184 | + }
|
|
| 185 | + |
|
| 186 | + // first try a cheap test
|
|
| 187 | + if (RELAXED_LOAD_ALWAYS(&stopped)) {
|
|
| 188 | + OS_ACQUIRE_LOCK(&mutex);
|
|
| 189 | + // should we really stop?
|
|
| 190 | + if (stopped) {
|
|
| 191 | + waitCondition(&start_cond, &mutex);
|
|
| 192 | + }
|
|
| 193 | + OS_RELEASE_LOCK(&mutex);
|
|
| 194 | + } else {
|
|
| 195 | + handle_tick(0);
|
|
| 196 | + }
|
|
| 197 | + }
|
|
| 198 | + |
|
| 199 | + return NULL;
|
|
| 200 | +}
|
|
| 201 | + |
|
| 202 | +void
|
|
| 203 | +initTicker (Time interval, TickProc handle_tick)
|
|
| 204 | +{
|
|
| 205 | + itimer_interval = interval;
|
|
| 206 | + stopped = true;
|
|
| 207 | + exited = false;
|
|
| 208 | +#if defined(HAVE_SIGNAL_H)
|
|
| 209 | + sigset_t mask, omask;
|
|
| 210 | + int sigret;
|
|
| 211 | +#endif
|
|
| 212 | + int ret;
|
|
| 213 | + |
|
| 214 | + initCondition(&start_cond);
|
|
| 215 | + initMutex(&mutex);
|
|
| 216 | + |
|
| 217 | + /* Open the interrupt fd synchronously.
|
|
| 218 | + *
|
|
| 219 | + * We used to do it in itimer_thread_func (i.e. in the timer thread) but it
|
|
| 220 | + * meant that some user code could run before it and get confused by the
|
|
| 221 | + * allocation of the timerfd.
|
|
| 222 | + *
|
|
| 223 | + * See hClose002 which unsafely closes a file descriptor twice expecting an
|
|
| 224 | + * exception the second time: it sometimes failed when the second call to
|
|
| 225 | + * "close" closed our own timerfd which inadvertently reused the same file
|
|
| 226 | + * descriptor closed by the first call! (see #20618)
|
|
| 227 | + */
|
|
| 228 | + |
|
| 229 | + if (interruptfd_r != -1) {
|
|
| 230 | + // don't leak the old file descriptors after a fork (#25280)
|
|
| 231 | + closeFdWakeup(interruptfd_r, interruptfd_w);
|
|
| 232 | + }
|
|
| 233 | + newFdWakeup(&interruptfd_r, &interruptfd_w);
|
|
| 234 | + |
|
| 235 | + /*
|
|
| 236 | + * Create the thread with all blockable signals blocked, leaving signal
|
|
| 237 | + * handling to the main and/or other threads. This is especially useful in
|
|
| 238 | + * the non-threaded runtime, where applications might expect sigprocmask(2)
|
|
| 239 | + * to effectively block signals.
|
|
| 240 | + */
|
|
| 241 | +#if defined(HAVE_SIGNAL_H)
|
|
| 242 | + sigfillset(&mask);
|
|
| 243 | + sigret = pthread_sigmask(SIG_SETMASK, &mask, &omask);
|
|
| 244 | +#endif
|
|
| 245 | + ret = createAttachedOSThread(&thread, "ghc_ticker", itimer_thread_func, (void*)handle_tick);
|
|
| 246 | +#if defined(HAVE_SIGNAL_H)
|
|
| 247 | + if (sigret == 0)
|
|
| 248 | + pthread_sigmask(SIG_SETMASK, &omask, NULL);
|
|
| 39 | 249 | #endif
|
| 250 | + |
|
| 251 | + if (ret != 0) {
|
|
| 252 | + barf("Ticker: Failed to spawn thread: %s", strerror(errno));
|
|
| 253 | + }
|
|
| 254 | +}
|
|
| 255 | + |
|
| 256 | +void
|
|
| 257 | +startTicker(void)
|
|
| 258 | +{
|
|
| 259 | + OS_ACQUIRE_LOCK(&mutex);
|
|
| 260 | + RELAXED_STORE(&stopped, false);
|
|
| 261 | + signalCondition(&start_cond);
|
|
| 262 | + OS_RELEASE_LOCK(&mutex);
|
|
| 263 | +}
|
|
| 264 | + |
|
| 265 | +/* There may be at most one additional tick fired after a call to this */
|
|
| 266 | +void
|
|
| 267 | +stopTicker(void)
|
|
| 268 | +{
|
|
| 269 | + OS_ACQUIRE_LOCK(&mutex);
|
|
| 270 | + RELAXED_STORE(&stopped, true);
|
|
| 271 | + OS_RELEASE_LOCK(&mutex);
|
|
| 272 | +}
|
|
| 273 | + |
|
| 274 | +/* There may be at most one additional tick fired after a call to this */
|
|
| 275 | +void
|
|
| 276 | +exitTicker (bool wait)
|
|
| 277 | +{
|
|
| 278 | + ASSERT(!SEQ_CST_LOAD(&exited));
|
|
| 279 | + SEQ_CST_STORE(&exited, true);
|
|
| 280 | + // ensure that ticker wakes up if stopped
|
|
| 281 | + startTicker();
|
|
| 282 | + sendFdWakeup(interruptfd_w);
|
|
| 283 | + |
|
| 284 | + // wait for ticker to terminate if necessary
|
|
| 285 | + if (wait) {
|
|
| 286 | + if (pthread_join(thread, NULL)) {
|
|
| 287 | + sysErrorBelch("Ticker: Failed to join: %s", strerror(errno));
|
|
| 288 | + }
|
|
| 289 | + closeFdWakeup(interruptfd_r, interruptfd_w);
|
|
| 290 | + closeMutex(&mutex);
|
|
| 291 | + closeCondition(&start_cond);
|
|
| 292 | + } else {
|
|
| 293 | + pthread_detach(thread);
|
|
| 294 | + }
|
|
| 295 | +}
|
|
| 296 | + |
|
| 297 | +int
|
|
| 298 | +rtsTimerSignal(void)
|
|
| 299 | +{
|
|
| 300 | + return SIGALRM;
|
|
| 301 | +} |
| 1 | -/* -----------------------------------------------------------------------------
|
|
| 2 | - *
|
|
| 3 | - * (c) The GHC Team, 1995-2007
|
|
| 4 | - *
|
|
| 5 | - * Interval timer for profiling and pre-emptive scheduling.
|
|
| 6 | - *
|
|
| 7 | - * ---------------------------------------------------------------------------*/
|
|
| 8 | - |
|
| 9 | -/*
|
|
| 10 | - * We use a realtime timer by default. I found this much more
|
|
| 11 | - * reliable than a CPU timer:
|
|
| 12 | - *
|
|
| 13 | - * Experiments with different frequencies: using
|
|
| 14 | - * CLOCK_REALTIME/CLOCK_MONOTONIC on Linux 2.6.32,
|
|
| 15 | - * 1000us has <1% impact on runtime
|
|
| 16 | - * 100us has ~2% impact on runtime
|
|
| 17 | - * 10us has ~40% impact on runtime
|
|
| 18 | - *
|
|
| 19 | - * using CLOCK_PROCESS_CPUTIME_ID on Linux 2.6.32,
|
|
| 20 | - * I cannot get it to tick faster than 10ms (10000us)
|
|
| 21 | - * which isn't great for profiling.
|
|
| 22 | - *
|
|
| 23 | - * In the threaded RTS, we can't tick in CPU time because the thread
|
|
| 24 | - * which has the virtual timer might be idle, so the tick would never
|
|
| 25 | - * fire. Therefore we used to tick in realtime in the threaded RTS and
|
|
| 26 | - * in CPU time otherwise, but now we always tick in realtime, for
|
|
| 27 | - * several reasons:
|
|
| 28 | - *
|
|
| 29 | - * - resolution (see above)
|
|
| 30 | - * - consistency (-threaded is the same as normal)
|
|
| 31 | - * - more consistency: Windows only has a realtime timer
|
|
| 32 | - *
|
|
| 33 | - * Note we want to use CLOCK_MONOTONIC rather than CLOCK_REALTIME,
|
|
| 34 | - * because the latter may jump around (NTP adjustments, leap seconds
|
|
| 35 | - * etc.).
|
|
| 36 | - */
|
|
| 37 | - |
|
| 38 | -#include "rts/PosixSource.h"
|
|
| 39 | -#include "Rts.h"
|
|
| 40 | - |
|
| 41 | -#include "Ticker.h"
|
|
| 42 | -#include "RtsUtils.h"
|
|
| 43 | -#include "Proftimer.h"
|
|
| 44 | -#include "Schedule.h"
|
|
| 45 | -#include "posix/Clock.h"
|
|
| 46 | -#include <poll.h>
|
|
| 47 | - |
|
| 48 | -#include <time.h>
|
|
| 49 | -#if HAVE_SYS_TIME_H
|
|
| 50 | -# include <sys/time.h>
|
|
| 51 | -#endif
|
|
| 52 | - |
|
| 53 | -#if defined(HAVE_SIGNAL_H)
|
|
| 54 | -# include <signal.h>
|
|
| 55 | -#endif
|
|
| 56 | - |
|
| 57 | -#include <string.h>
|
|
| 58 | - |
|
| 59 | -#include <pthread.h>
|
|
| 60 | -#if defined(HAVE_PTHREAD_NP_H)
|
|
| 61 | -#include <pthread_np.h>
|
|
| 62 | -#endif
|
|
| 63 | -#include <unistd.h>
|
|
| 64 | -#include <fcntl.h>
|
|
| 65 | - |
|
| 66 | -/*
|
|
| 67 | - * TFD_CLOEXEC has been added in Linux 2.6.26.
|
|
| 68 | - * If it is not available, we use fcntl(F_SETFD).
|
|
| 69 | - */
|
|
| 70 | -#if !defined(TFD_CLOEXEC)
|
|
| 71 | -#define TFD_CLOEXEC 0
|
|
| 72 | -#endif
|
|
| 73 | - |
|
| 74 | -static Time itimer_interval = DEFAULT_TICK_INTERVAL;
|
|
| 75 | - |
|
| 76 | -// Should we be firing ticks?
|
|
| 77 | -// Writers to this must hold the mutex below.
|
|
| 78 | -static bool stopped = false;
|
|
| 79 | - |
|
| 80 | -// should the ticker thread exit?
|
|
| 81 | -// This can be set without holding the mutex.
|
|
| 82 | -static bool exited = true;
|
|
| 83 | - |
|
| 84 | -// Signaled when we want to (re)start the timer
|
|
| 85 | -static Condition start_cond;
|
|
| 86 | -static Mutex mutex;
|
|
| 87 | -static OSThreadId thread;
|
|
| 88 | - |
|
| 89 | -static void *itimer_thread_func(void *_handle_tick)
|
|
| 90 | -{
|
|
| 91 | - TickProc handle_tick = _handle_tick;
|
|
| 92 | - |
|
| 93 | - // Relaxed is sufficient: If we don't see that exited was set in one iteration we will
|
|
| 94 | - // see it next time.
|
|
| 95 | - while (!RELAXED_LOAD_ALWAYS(&exited)) {
|
|
| 96 | - if (rtsSleep(itimer_interval) != 0) {
|
|
| 97 | - sysErrorBelch("Ticker: sleep failed: %s", strerror(errno));
|
|
| 98 | - }
|
|
| 99 | - |
|
| 100 | - // first try a cheap test
|
|
| 101 | - if (RELAXED_LOAD_ALWAYS(&stopped)) {
|
|
| 102 | - OS_ACQUIRE_LOCK(&mutex);
|
|
| 103 | - // should we really stop?
|
|
| 104 | - if (stopped) {
|
|
| 105 | - waitCondition(&start_cond, &mutex);
|
|
| 106 | - }
|
|
| 107 | - OS_RELEASE_LOCK(&mutex);
|
|
| 108 | - } else {
|
|
| 109 | - handle_tick(0);
|
|
| 110 | - }
|
|
| 111 | - }
|
|
| 112 | - |
|
| 113 | - return NULL;
|
|
| 114 | -}
|
|
| 115 | - |
|
| 116 | -void
|
|
| 117 | -initTicker (Time interval, TickProc handle_tick)
|
|
| 118 | -{
|
|
| 119 | - itimer_interval = interval;
|
|
| 120 | - stopped = true;
|
|
| 121 | - exited = false;
|
|
| 122 | -#if defined(HAVE_SIGNAL_H)
|
|
| 123 | - sigset_t mask, omask;
|
|
| 124 | - int sigret;
|
|
| 125 | -#endif
|
|
| 126 | - int ret;
|
|
| 127 | - |
|
| 128 | - initCondition(&start_cond);
|
|
| 129 | - initMutex(&mutex);
|
|
| 130 | - |
|
| 131 | - /*
|
|
| 132 | - * Create the thread with all blockable signals blocked, leaving signal
|
|
| 133 | - * handling to the main and/or other threads. This is especially useful in
|
|
| 134 | - * the non-threaded runtime, where applications might expect sigprocmask(2)
|
|
| 135 | - * to effectively block signals.
|
|
| 136 | - */
|
|
| 137 | -#if defined(HAVE_SIGNAL_H)
|
|
| 138 | - sigfillset(&mask);
|
|
| 139 | - sigret = pthread_sigmask(SIG_SETMASK, &mask, &omask);
|
|
| 140 | -#endif
|
|
| 141 | - ret = createAttachedOSThread(&thread, "ghc_ticker", itimer_thread_func, (void*)handle_tick);
|
|
| 142 | -#if defined(HAVE_SIGNAL_H)
|
|
| 143 | - if (sigret == 0)
|
|
| 144 | - pthread_sigmask(SIG_SETMASK, &omask, NULL);
|
|
| 145 | -#endif
|
|
| 146 | - |
|
| 147 | - if (ret != 0) {
|
|
| 148 | - barf("Ticker: Failed to spawn thread: %s", strerror(errno));
|
|
| 149 | - }
|
|
| 150 | -}
|
|
| 151 | - |
|
| 152 | -void
|
|
| 153 | -startTicker(void)
|
|
| 154 | -{
|
|
| 155 | - OS_ACQUIRE_LOCK(&mutex);
|
|
| 156 | - RELAXED_STORE(&stopped, false);
|
|
| 157 | - signalCondition(&start_cond);
|
|
| 158 | - OS_RELEASE_LOCK(&mutex);
|
|
| 159 | -}
|
|
| 160 | - |
|
| 161 | -/* There may be at most one additional tick fired after a call to this */
|
|
| 162 | -void
|
|
| 163 | -stopTicker(void)
|
|
| 164 | -{
|
|
| 165 | - OS_ACQUIRE_LOCK(&mutex);
|
|
| 166 | - RELAXED_STORE(&stopped, true);
|
|
| 167 | - OS_RELEASE_LOCK(&mutex);
|
|
| 168 | -}
|
|
| 169 | - |
|
| 170 | -/* There may be at most one additional tick fired after a call to this */
|
|
| 171 | -void
|
|
| 172 | -exitTicker (bool wait)
|
|
| 173 | -{
|
|
| 174 | - ASSERT(!SEQ_CST_LOAD(&exited));
|
|
| 175 | - SEQ_CST_STORE(&exited, true);
|
|
| 176 | - // ensure that ticker wakes up if stopped
|
|
| 177 | - startTicker();
|
|
| 178 | - |
|
| 179 | - // wait for ticker to terminate if necessary
|
|
| 180 | - if (wait) {
|
|
| 181 | - if (pthread_join(thread, NULL)) {
|
|
| 182 | - sysErrorBelch("Ticker: Failed to join: %s", strerror(errno));
|
|
| 183 | - }
|
|
| 184 | - closeMutex(&mutex);
|
|
| 185 | - closeCondition(&start_cond);
|
|
| 186 | - } else {
|
|
| 187 | - pthread_detach(thread);
|
|
| 188 | - }
|
|
| 189 | -}
|
|
| 190 | - |
|
| 191 | -int
|
|
| 192 | -rtsTimerSignal(void)
|
|
| 193 | -{
|
|
| 194 | - return SIGALRM;
|
|
| 195 | -} |
| 1 | -/* -----------------------------------------------------------------------------
|
|
| 2 | - *
|
|
| 3 | - * (c) The GHC Team, 1995-2023
|
|
| 4 | - *
|
|
| 5 | - * Interval timer for profiling and pre-emptive scheduling.
|
|
| 6 | - *
|
|
| 7 | - * ---------------------------------------------------------------------------*/
|
|
| 8 | - |
|
| 9 | -/*
|
|
| 10 | - * We use a realtime timer by default. I found this much more
|
|
| 11 | - * reliable than a CPU timer:
|
|
| 12 | - *
|
|
| 13 | - * Experiments with different frequencies: using
|
|
| 14 | - * CLOCK_REALTIME/CLOCK_MONOTONIC on Linux 2.6.32,
|
|
| 15 | - * 1000us has <1% impact on runtime
|
|
| 16 | - * 100us has ~2% impact on runtime
|
|
| 17 | - * 10us has ~40% impact on runtime
|
|
| 18 | - *
|
|
| 19 | - * using CLOCK_PROCESS_CPUTIME_ID on Linux 2.6.32,
|
|
| 20 | - * I cannot get it to tick faster than 10ms (10000us)
|
|
| 21 | - * which isn't great for profiling.
|
|
| 22 | - *
|
|
| 23 | - * In the threaded RTS, we can't tick in CPU time because the thread
|
|
| 24 | - * which has the virtual timer might be idle, so the tick would never
|
|
| 25 | - * fire. Therefore we used to tick in realtime in the threaded RTS and
|
|
| 26 | - * in CPU time otherwise, but now we always tick in realtime, for
|
|
| 27 | - * several reasons:
|
|
| 28 | - *
|
|
| 29 | - * - resolution (see above)
|
|
| 30 | - * - consistency (-threaded is the same as normal)
|
|
| 31 | - * - more consistency: Windows only has a realtime timer
|
|
| 32 | - *
|
|
| 33 | - * Note we want to use CLOCK_MONOTONIC rather than CLOCK_REALTIME,
|
|
| 34 | - * because the latter may jump around (NTP adjustments, leap seconds
|
|
| 35 | - * etc.).
|
|
| 36 | - */
|
|
| 37 | - |
|
| 38 | -#include "rts/PosixSource.h"
|
|
| 39 | -#include "Rts.h"
|
|
| 40 | - |
|
| 41 | -#include "Ticker.h"
|
|
| 42 | -#include "RtsUtils.h"
|
|
| 43 | -#include "Proftimer.h"
|
|
| 44 | -#include "Schedule.h"
|
|
| 45 | -#include "posix/Clock.h"
|
|
| 46 | -#include <poll.h>
|
|
| 47 | - |
|
| 48 | -#include <time.h>
|
|
| 49 | -#if HAVE_SYS_TIME_H
|
|
| 50 | -# include <sys/time.h>
|
|
| 51 | -#endif
|
|
| 52 | - |
|
| 53 | -#if defined(HAVE_SIGNAL_H)
|
|
| 54 | -# include <signal.h>
|
|
| 55 | -#endif
|
|
| 56 | - |
|
| 57 | -#include <string.h>
|
|
| 58 | - |
|
| 59 | -#include <pthread.h>
|
|
| 60 | -#if defined(HAVE_PTHREAD_NP_H)
|
|
| 61 | -#include <pthread_np.h>
|
|
| 62 | -#endif
|
|
| 63 | -#include <unistd.h>
|
|
| 64 | -#include <fcntl.h>
|
|
| 65 | - |
|
| 66 | -#include <sys/timerfd.h>
|
|
| 67 | - |
|
| 68 | - |
|
| 69 | -/*
|
|
| 70 | - * TFD_CLOEXEC has been added in Linux 2.6.26.
|
|
| 71 | - * If it is not available, we use fcntl(F_SETFD).
|
|
| 72 | - */
|
|
| 73 | -#if !defined(TFD_CLOEXEC)
|
|
| 74 | -#define TFD_CLOEXEC 0
|
|
| 75 | -#endif
|
|
| 76 | - |
|
| 77 | -static Time itimer_interval = DEFAULT_TICK_INTERVAL;
|
|
| 78 | - |
|
| 79 | -// Should we be firing ticks?
|
|
| 80 | -// Writers to this must hold the mutex below.
|
|
| 81 | -static bool stopped = false;
|
|
| 82 | - |
|
| 83 | -// should the ticker thread exit?
|
|
| 84 | -// This can be set without holding the mutex.
|
|
| 85 | -static bool exited = true;
|
|
| 86 | - |
|
| 87 | -// Signaled when we want to (re)start the timer
|
|
| 88 | -static Condition start_cond;
|
|
| 89 | -static Mutex mutex;
|
|
| 90 | -static OSThreadId thread;
|
|
| 91 | - |
|
| 92 | -// file descriptor for the timer (Linux only)
|
|
| 93 | -static int timerfd = -1;
|
|
| 94 | - |
|
| 95 | -// pipe for signaling exit
|
|
| 96 | -static int pipefds[2];
|
|
| 97 | - |
|
| 98 | -static void *itimer_thread_func(void *_handle_tick)
|
|
| 99 | -{
|
|
| 100 | - TickProc handle_tick = _handle_tick;
|
|
| 101 | - uint64_t nticks;
|
|
| 102 | - ssize_t r = 0;
|
|
| 103 | - struct pollfd pollfds[2];
|
|
| 104 | - |
|
| 105 | - pollfds[0].fd = pipefds[0];
|
|
| 106 | - pollfds[0].events = POLLIN;
|
|
| 107 | - pollfds[1].fd = timerfd;
|
|
| 108 | - pollfds[1].events = POLLIN;
|
|
| 109 | - |
|
| 110 | - // Relaxed is sufficient: If we don't see that exited was set in one iteration we will
|
|
| 111 | - // see it next time.
|
|
| 112 | - while (!RELAXED_LOAD_ALWAYS(&exited)) {
|
|
| 113 | - if (poll(pollfds, 2, -1) == -1) {
|
|
| 114 | - // While the RTS attempts to mask signals, some foreign libraries
|
|
| 115 | - // may rely on signal delivery may unmask them. Consequently we may
|
|
| 116 | - // see EINTR. See #24610.
|
|
| 117 | - if (errno != EINTR) {
|
|
| 118 | - sysErrorBelch("Ticker: poll failed: %s", strerror(errno));
|
|
| 119 | - }
|
|
| 120 | - }
|
|
| 121 | - |
|
| 122 | - // We check the pipe first, even though the timerfd may also have triggered.
|
|
| 123 | - if (pollfds[0].revents & POLLIN) {
|
|
| 124 | - // the pipe is ready for reading, the only possible reason is that we're exiting
|
|
| 125 | - exited = true; // set this again to make sure even RELAXED_LOAD will read the proper value
|
|
| 126 | - // no further action needed, skip ahead to handling the final tick and then stopping
|
|
| 127 | - }
|
|
| 128 | - else if (pollfds[1].revents & POLLIN) { // the timerfd is ready for reading
|
|
| 129 | - r = read(timerfd, &nticks, sizeof(nticks)); // this should never block now
|
|
| 130 | - |
|
| 131 | - if ((r == 0) && (errno == 0)) {
|
|
| 132 | - /* r == 0 is expected only for non-blocking fd (in which case
|
|
| 133 | - * errno should be EAGAIN) but we use a blocking fd.
|
|
| 134 | - *
|
|
| 135 | - * Due to a kernel bug (cf https://lkml.org/lkml/2019/8/16/335)
|
|
| 136 | - * on some platforms we could see r == 0 and errno == 0.
|
|
| 137 | - */
|
|
| 138 | - IF_DEBUG(scheduler, debugBelch("read(timerfd) returned 0 with errno=0. This is a known kernel bug. We just ignore it."));
|
|
| 139 | - }
|
|
| 140 | - else if (r != sizeof(nticks) && errno != EINTR) {
|
|
| 141 | - barf("Ticker: read(timerfd) failed with %s and returned %zd", strerror(errno), r);
|
|
| 142 | - }
|
|
| 143 | - }
|
|
| 144 | - |
|
| 145 | - // first try a cheap test
|
|
| 146 | - if (RELAXED_LOAD_ALWAYS(&stopped)) {
|
|
| 147 | - OS_ACQUIRE_LOCK(&mutex);
|
|
| 148 | - // should we really stop?
|
|
| 149 | - if (stopped) {
|
|
| 150 | - waitCondition(&start_cond, &mutex);
|
|
| 151 | - }
|
|
| 152 | - OS_RELEASE_LOCK(&mutex);
|
|
| 153 | - } else {
|
|
| 154 | - handle_tick(0);
|
|
| 155 | - }
|
|
| 156 | - }
|
|
| 157 | - |
|
| 158 | - close(timerfd);
|
|
| 159 | - return NULL;
|
|
| 160 | -}
|
|
| 161 | - |
|
| 162 | -void
|
|
| 163 | -initTicker (Time interval, TickProc handle_tick)
|
|
| 164 | -{
|
|
| 165 | - itimer_interval = interval;
|
|
| 166 | - stopped = true;
|
|
| 167 | - exited = false;
|
|
| 168 | -#if defined(HAVE_SIGNAL_H)
|
|
| 169 | - sigset_t mask, omask;
|
|
| 170 | - int sigret;
|
|
| 171 | -#endif
|
|
| 172 | - int ret;
|
|
| 173 | - |
|
| 174 | - initCondition(&start_cond);
|
|
| 175 | - initMutex(&mutex);
|
|
| 176 | - |
|
| 177 | - /* Open the file descriptor for the timer synchronously.
|
|
| 178 | - *
|
|
| 179 | - * We used to do it in itimer_thread_func (i.e. in the timer thread) but it
|
|
| 180 | - * meant that some user code could run before it and get confused by the
|
|
| 181 | - * allocation of the timerfd.
|
|
| 182 | - *
|
|
| 183 | - * See hClose002 which unsafely closes a file descriptor twice expecting an
|
|
| 184 | - * exception the second time: it sometimes failed when the second call to
|
|
| 185 | - * "close" closed our own timerfd which inadvertently reused the same file
|
|
| 186 | - * descriptor closed by the first call! (see #20618)
|
|
| 187 | - */
|
|
| 188 | - struct itimerspec it;
|
|
| 189 | - it.it_value.tv_sec = TimeToSeconds(itimer_interval);
|
|
| 190 | - it.it_value.tv_nsec = TimeToNS(itimer_interval) % 1000000000;
|
|
| 191 | - it.it_interval = it.it_value;
|
|
| 192 | - |
|
| 193 | - if (timerfd != -1) {
|
|
| 194 | - // don't leak the old file descriptors after a fork (#25280)
|
|
| 195 | - close(timerfd);
|
|
| 196 | - close(pipefds[0]);
|
|
| 197 | - close(pipefds[1]);
|
|
| 198 | - timerfd = -1;
|
|
| 199 | - }
|
|
| 200 | - |
|
| 201 | - timerfd = timerfd_create(CLOCK_MONOTONIC, TFD_CLOEXEC);
|
|
| 202 | - if (timerfd == -1) {
|
|
| 203 | - barf("timerfd_create: %s", strerror(errno));
|
|
| 204 | - }
|
|
| 205 | - if (!TFD_CLOEXEC) {
|
|
| 206 | - fcntl(timerfd, F_SETFD, FD_CLOEXEC);
|
|
| 207 | - }
|
|
| 208 | - if (timerfd_settime(timerfd, 0, &it, NULL)) {
|
|
| 209 | - barf("timerfd_settime: %s", strerror(errno));
|
|
| 210 | - }
|
|
| 211 | - |
|
| 212 | - if (pipe(pipefds) < 0) {
|
|
| 213 | - barf("pipe: %s", strerror(errno));
|
|
| 214 | - }
|
|
| 215 | - |
|
| 216 | - /*
|
|
| 217 | - * Create the thread with all blockable signals blocked, leaving signal
|
|
| 218 | - * handling to the main and/or other threads. This is especially useful in
|
|
| 219 | - * the non-threaded runtime, where applications might expect sigprocmask(2)
|
|
| 220 | - * to effectively block signals.
|
|
| 221 | - */
|
|
| 222 | -#if defined(HAVE_SIGNAL_H)
|
|
| 223 | - sigfillset(&mask);
|
|
| 224 | - sigret = pthread_sigmask(SIG_SETMASK, &mask, &omask);
|
|
| 225 | -#endif
|
|
| 226 | - ret = createAttachedOSThread(&thread, "ghc_ticker", itimer_thread_func, (void*)handle_tick);
|
|
| 227 | -#if defined(HAVE_SIGNAL_H)
|
|
| 228 | - if (sigret == 0)
|
|
| 229 | - pthread_sigmask(SIG_SETMASK, &omask, NULL);
|
|
| 230 | -#endif
|
|
| 231 | - |
|
| 232 | - if (ret != 0) {
|
|
| 233 | - barf("Ticker: Failed to spawn thread: %s", strerror(errno));
|
|
| 234 | - }
|
|
| 235 | -}
|
|
| 236 | - |
|
| 237 | -void
|
|
| 238 | -startTicker(void)
|
|
| 239 | -{
|
|
| 240 | - OS_ACQUIRE_LOCK(&mutex);
|
|
| 241 | - RELAXED_STORE(&stopped, false);
|
|
| 242 | - signalCondition(&start_cond);
|
|
| 243 | - OS_RELEASE_LOCK(&mutex);
|
|
| 244 | -}
|
|
| 245 | - |
|
| 246 | -/* There may be at most one additional tick fired after a call to this */
|
|
| 247 | -void
|
|
| 248 | -stopTicker(void)
|
|
| 249 | -{
|
|
| 250 | - OS_ACQUIRE_LOCK(&mutex);
|
|
| 251 | - RELAXED_STORE(&stopped, true);
|
|
| 252 | - OS_RELEASE_LOCK(&mutex);
|
|
| 253 | -}
|
|
| 254 | - |
|
| 255 | -/* There may be at most one additional tick fired after a call to this */
|
|
| 256 | -void
|
|
| 257 | -exitTicker (bool wait)
|
|
| 258 | -{
|
|
| 259 | - ASSERT(!SEQ_CST_LOAD(&exited));
|
|
| 260 | - SEQ_CST_STORE(&exited, true);
|
|
| 261 | - // ensure that ticker wakes up if stopped
|
|
| 262 | - startTicker();
|
|
| 263 | - |
|
| 264 | - // wait for ticker to terminate if necessary
|
|
| 265 | - if (wait) {
|
|
| 266 | - // write anything to the pipe to trigger poll() in the ticker thread
|
|
| 267 | - if (write(pipefds[1], "stop", 5) < 0) {
|
|
| 268 | - sysErrorBelch("Ticker: Failed to write to pipe: %s", strerror(errno));
|
|
| 269 | - }
|
|
| 270 | - |
|
| 271 | - if (pthread_join(thread, NULL)) {
|
|
| 272 | - sysErrorBelch("Ticker: Failed to join: %s", strerror(errno));
|
|
| 273 | - }
|
|
| 274 | - |
|
| 275 | - // These need to happen AFTER the ticker thread has finished to prevent a race condition
|
|
| 276 | - // where the ticker thread closes the read end of the pipe before we're done writing to it.
|
|
| 277 | - close(pipefds[0]);
|
|
| 278 | - close(pipefds[1]);
|
|
| 279 | - |
|
| 280 | - closeMutex(&mutex);
|
|
| 281 | - closeCondition(&start_cond);
|
|
| 282 | - } else {
|
|
| 283 | - pthread_detach(thread);
|
|
| 284 | - }
|
|
| 285 | -}
|
|
| 286 | - |
|
| 287 | -int
|
|
| 288 | -rtsTimerSignal(void)
|
|
| 289 | -{
|
|
| 290 | - return SIGALRM;
|
|
| 291 | -} |
| ... | ... | @@ -582,11 +582,9 @@ library |
| 582 | 582 | posix/Ticker.c
|
| 583 | 583 | posix/OSMem.c
|
| 584 | 584 | posix/OSThreads.c
|
| 585 | + posix/FdWakeup.c
|
|
| 585 | 586 | posix/Poll.c
|
| 586 | 587 | posix/Select.c
|
| 587 | 588 | posix/Signals.c
|
| 588 | 589 | posix/Timeout.c
|
| 589 | 590 | posix/TTY.c |
| 590 | - -- ticker/*.c
|
|
| 591 | - -- We don't want to compile posix/ticker/*.c, these will be #included
|
|
| 592 | - -- from Ticker.c |
| ... | ... | @@ -1339,7 +1339,7 @@ concurrent_marking: |
| 1339 | 1339 | nonmovingPrintAllocatorCensus(!concurrent);
|
| 1340 | 1340 | #endif
|
| 1341 | 1341 | #if defined(TRACING)
|
| 1342 | - if (RtsFlags.TraceFlags.nonmoving_gc)
|
|
| 1342 | + if (RTS_UNLIKELY(TRACE_nonmoving_gc))
|
|
| 1343 | 1343 | nonmovingTraceAllocatorCensus();
|
| 1344 | 1344 | #endif
|
| 1345 | 1345 |
| 1 | +{-# LANGUAGE TemplateHaskell #-}
|
|
| 2 | +-- | This tests the behaviour of TH's recover method.
|
|
| 3 | +-- It should behave the same in the internal and external interperter.
|
|
| 4 | +-- In the past, they have diverged, and the external interpreter would roll back the state of putQ/getQ whereas the internal interpreter would not.
|
|
| 5 | +module Main where
|
|
| 6 | + |
|
| 7 | +import Language.Haskell.TH.Syntax
|
|
| 8 | +main = print $(putQ "0" >> recover (pure ()) (putQ "42" >> fail "oops") >> getQ @String >>= lift ) |
| 1 | +Just "42" |
| ... | ... | @@ -650,3 +650,4 @@ test('GadtConSigs_th_dump1', normal, compile, ['-v0 -ddump-splices -dsuppress-un |
| 650 | 650 | test('T26099', normal, compile_fail, [''])
|
| 651 | 651 | test('T8306_th', only_ways(['ghci']), ghci_script, ['T8306_th.script'])
|
| 652 | 652 | test('T26862_th', only_ways(['ghci']), ghci_script, ['T26862_th.script'])
|
| 653 | +test('T27022', normal, compile_and_run, ['']) |