Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: a116ca75 by Zubin Duggal at 2026-04-02T21:29:21-04:00 driver: recognise .dyn_o as a valid object file to link if passed on the command line. This allows plugins compiled with this suffix to run. Fixes #24486 - - - - - 5ca0ec57 by Simon Jakobi at 2026-04-02T21:29:24-04:00 Add regression test for #16145 Closes #16145. - - - - - de30ea3b by Matthew Pickering at 2026-04-02T21:29:24-04:00 bytecode: Add magic header/version to bytecode files In order to avoid confusing errors when using stale interface files (ie from an older compiler version), we add a simple header/version check like the one for interface files. Fixes #27068 - - - - - f6cd6f2d by fendor at 2026-04-02T21:29:25-04:00 Add constants for bytecode in-memory buffer size Introduce a common constant for the default size of the .gbc and .bytecodelib binary buffer. The buffer is by default set to 1 MB. - - - - - 1a2b7f11 by Duncan Coutts at 2026-04-02T21:29:26-04:00 Add a rts posix FdWakup utility module This will be used to implement wakeupIOManager for in-RTS I/O managers. It provides a notification/wakeup mechanism using FDs, suitable for situations when a thread is blocked on a set of fds anyway. It uses the classic self-pipe trick, or equivalently eventfd on supported platforms. This will initially be used to implement prompt interrupt or shutdown of the posix ticker thread. - - - - - 66f81c55 by Duncan Coutts at 2026-04-02T21:29:26-04:00 Add prompt shutdown to the pthread ticker implementation. The Linux timerfd ticker monitors a pipe which is used by exitTicker to ensure a prompt wakeup and shutdown. The pthread ticker lacked this and so would only exit at the next ticker wakeup (10ms by default). This patch adds the same mechanism to the pthread ticker. This changes the pthread ticker from waiting by using nanosleep() to waiting using either ppoll() or select(), so that it can wait on both a time and a file descriptor. On Linux at least, a test program to compare the timing jitter of these APIs shows that using nanpsleep, ppoll or select makes no statistical difference to the maximum or average jitter. This is a step towards unifying the posix ticker implementations, so that we can have just one portable one (albeit with some limited cpp). It is also a step towards using the ticker as part of a more general implementation of wakeUpRts, since this will require a method to wake the rts from a signal handler context (ctl-c handler). - - - - - 13b86936 by Duncan Coutts at 2026-04-02T21:29:26-04:00 Update ticker header commentary It was antique and didn't apply even to the previous implementation, and certainly not to the updated one. - - - - - 1f0d1bad by Duncan Coutts at 2026-04-02T21:29:26-04:00 Remove the timerfd-based ticker implementation There does not appear to be any remaining advantage on Linux to using the timerfd ticker implementation over the portable one (using ppoll on Linux for precise timing). The eventfd implementation was originally added at a time when Linux was still using a signal based implementation. So it made sense at the time. See (closed) issue #10840. - - - - - 21e4fd73 by Duncan Coutts at 2026-04-02T21:29:26-04:00 Consolidate to a single posix ticker implementation Previously we had four implementations, two using signals and two using threads. Having just one should make behaviour more consistent between platforms, and should make maintenance easier. - - - - - 119c0dfc by mangoiv at 2026-04-02T21:29:27-04:00 testsuite: filter stderr for static001 on darwin This reactivates the test on x86_64 darwin as this should have been done long ago and ignores warnings emitted by ranlib on newer version of the darwin toolchain since they are benign. (no symbols for stub libraries) Fixes #27116 - - - - - 3d644081 by mangoiv at 2026-04-02T21:29:28-04:00 issue template: fix add bug label - - - - - b5c7a63a by Sylvain Henry at 2026-04-02T21:29:37-04:00 Add more canned GC functions for common register patterns (#27142) Based on analysis of heap-check sites across the GHC compiler and Cabal, the following patterns were not covered by existing canned GC functions but occurred frequently enough to warrant specialisation: stg_gc_ppppp -- 5 GC pointers stg_gc_ip -- unboxed word + GC pointer stg_gc_pi -- GC pointer + unboxed word stg_gc_ii -- two unboxed words stg_gc_bpp -- byte (I8) + two GC pointers Adding these reduces the fraction of heap-check sites falling back to the generic GC path from ~1.4% to ~0.4% when compiling GHC itself. Co-Authored-By: Claude Sonnet 4.6 <noreply@anthropic.com> - - - - - 30 changed files: - .gitlab/issue_templates/default.md - compiler/GHC/ByteCode/Serialize.hs - compiler/GHC/Driver/Phases.hs - compiler/GHC/StgToCmm/Heap.hs - rts/HeapStackCheck.cmm - rts/RtsSymbols.c - rts/include/stg/MiscClosures.h - + 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 - testsuite/driver/testlib.py - testsuite/tests/driver/all.T - testsuite/tests/driver/bytecode-object/Makefile - testsuite/tests/driver/bytecode-object/all.T - testsuite/tests/plugins/Makefile - + testsuite/tests/plugins/T24486-plugin/Makefile - + testsuite/tests/plugins/T24486-plugin/Setup.hs - + testsuite/tests/plugins/T24486-plugin/T24486-plugin.cabal - + testsuite/tests/plugins/T24486-plugin/T24486_Plugin.hs - + testsuite/tests/plugins/T24486.hs - + testsuite/tests/plugins/T24486_Helper.hs - testsuite/tests/plugins/all.T - testsuite/tests/runghc/Makefile - + testsuite/tests/runghc/T16145.hs - + testsuite/tests/runghc/T16145.stdout - + testsuite/tests/runghc/T16145_aux.hs - testsuite/tests/runghc/all.T Changes: ===================================== .gitlab/issue_templates/default.md ===================================== @@ -20,5 +20,5 @@ Optional: * System Architecture: -/label ~bug +/label ~"T::bug" /label ~"needs triage" ===================================== compiler/GHC/ByteCode/Serialize.hs ===================================== @@ -25,22 +25,26 @@ where import GHC.Prelude import GHC.ByteCode.Binary -import GHC.ByteCode.Types import GHC.ByteCode.Recomp.Binary (computeFingerprint) -import GHC.Driver.Env +import GHC.ByteCode.Types import GHC.Driver.DynFlags +import GHC.Driver.Env import GHC.Iface.Binary import GHC.Iface.Recomp.Binary (putNameLiterally) import GHC.Linker.Types +import GHC.Settings.Constants (hiVersion) import GHC.Unit.Types import GHC.Utils.Binary -import GHC.Utils.TmpFs -import GHC.Utils.Logger import GHC.Utils.Fingerprint (Fingerprint) +import GHC.Utils.Logger +import GHC.Utils.Panic +import GHC.Utils.TmpFs import Data.ByteString (ByteString) -import qualified Data.ByteString as BS +import Data.ByteString qualified as BS +import Data.Char (ord) import Data.Traversable +import Data.Word import System.Directory import System.FilePath @@ -79,21 +83,35 @@ The ticket where bytecode objects were dicussed is #26298 See Note [-fwrite-byte-code is not the default] See Note [Recompilation avoidance with bytecode objects] +See Note [Persistent bytecode file headers] +Note [Persistent bytecode file headers] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Persistent bytecode files (`.gbc`) and bytecode libraries (`.bytecodelib`) +are version-specific binary formats. Without a small file-level header, stale +or corrupt files are only discovered once we start deserialising the payload, +which can lead to confusing failures. + +To make these failures explicit, we write a file-kind-specific magic word and +the current `hiVersion` ahead of the binary payload. Readers validate this +header before setting up the normal `Name`/`FastString` deserialisation +machinery. This follows the same approach as normal interface files. -} writeBytecodeLib :: BytecodeLib -> FilePath -> IO () writeBytecodeLib lib path = do odbco <- encodeBytecodeLib lib createDirectoryIfMissing True (takeDirectory path) - bh' <- openBinMem (1024 * 1024) + bh' <- openBinMem initBinMemSize bh <- addBinNameWriter bh' + writePersistentBytecodeHeader BytecodeLibraryFile bh putWithUserData QuietBinIFace NormalCompression bh odbco writeBinMem bh path readBytecodeLib :: HscEnv -> FilePath -> IO OnDiskBytecodeLib readBytecodeLib hsc_env path = do bh' <- readBinMem path + readPersistentBytecodeHeader BytecodeLibraryFile path bh' bh <- addBinNameReader (hsc_NC hsc_env) bh' res <- getWithUserData (hsc_NC hsc_env) bh pure res @@ -185,6 +203,7 @@ readBinByteCode hsc_env f = do readOnDiskModuleByteCode :: HscEnv -> FilePath -> IO OnDiskModuleByteCode readOnDiskModuleByteCode hsc_env f = do bh' <- readBinMem f + readPersistentBytecodeHeader ModuleByteCodeFile f bh' bh <- addBinNameReader (hsc_NC hsc_env) bh' getWithUserData (hsc_NC hsc_env) bh @@ -192,9 +211,10 @@ readOnDiskModuleByteCode hsc_env f = do writeBinByteCode :: FilePath -> ModuleByteCode -> IO () writeBinByteCode f cbc = do createDirectoryIfMissing True (takeDirectory f) - bh' <- openBinMem (1024 * 1024) + bh' <- openBinMem initBinMemSize bh <- addBinNameWriter bh' odbco <- encodeOnDiskModuleByteCode cbc + writePersistentBytecodeHeader ModuleByteCodeFile bh putWithUserData QuietBinIFace NormalCompression bh odbco writeBinMem bh f @@ -213,3 +233,64 @@ fingerprintModuleByteCodeContents :: Module -> CompiledByteCode -> [FilePath] -> fingerprintModuleByteCodeContents modl cbc foreign_files = do foreign_contents <- readObjectFiles foreign_files pure $ computeFingerprint putNameLiterally (modl, cbc, foreign_contents) + +-- ---------------------------------------------------------------------------- +-- ByteCode module and library magic header. +-- ---------------------------------------------------------------------------- + +data PersistentBytecodeFile + = ModuleByteCodeFile + | BytecodeLibraryFile + +-- See Note [Persistent bytecode file headers] +writePersistentBytecodeHeader :: PersistentBytecodeFile -> WriteBinHandle -> IO () +writePersistentBytecodeHeader file_kind bh = do + put_ bh (persistentBytecodeMagic file_kind) + put_ bh (show hiVersion) + +readPersistentBytecodeHeader :: PersistentBytecodeFile -> FilePath -> ReadBinHandle -> IO () +readPersistentBytecodeHeader file_kind path bh = do + let mismatch what expected actual = + throwGhcExceptionIO $ ProgramError $ + persistentBytecodeFileDescription file_kind ++ " header mismatch in " ++ path ++ + ": " ++ what ++ " (expected " ++ expected ++ ", got " ++ actual ++ ")" + + magic <- get bh + let expected_magic = persistentBytecodeMagic file_kind + if unFixedLength magic == unFixedLength expected_magic + then pure () + else mismatch "magic" (show $ unFixedLength expected_magic) (show $ unFixedLength magic) + + version <- get bh + let expected_version = show hiVersion + if version == expected_version + then pure () + else mismatch "version" expected_version version + +persistentBytecodeFileDescription :: PersistentBytecodeFile -> String +persistentBytecodeFileDescription ModuleByteCodeFile = "bytecode file" +persistentBytecodeFileDescription BytecodeLibraryFile = "bytecode library" + +persistentBytecodeMagic :: PersistentBytecodeFile -> FixedLengthEncoding Word32 +persistentBytecodeMagic file_kind = + case file_kind of + ModuleByteCodeFile -> asciiWord32 "gbc0" + BytecodeLibraryFile -> asciiWord32 "bcl0" + +-- | Encode a 4-letter word into a single Word32. +asciiWord32 :: String -> FixedLengthEncoding Word32 +asciiWord32 [a, b, c, d] = + FixedLengthEncoding $ + (fromIntegral (ord a) `shiftL` 24) .|. + (fromIntegral (ord b) `shiftL` 16) .|. + (fromIntegral (ord c) `shiftL` 8) .|. + fromIntegral (ord d) +asciiWord32 _ = error "asciiWord32: expected exactly four ASCII characters" + +-- ---------------------------------------------------------------------------- +-- Constants and utils +-- ---------------------------------------------------------------------------- + +-- | Initial ram buffer to allocate for writing .gbc and .bytecodelib files. +initBinMemSize :: Int +initBinMemSize = 1024 * 1024 -- 1 MB ===================================== compiler/GHC/Driver/Phases.hs ===================================== @@ -262,7 +262,7 @@ objish_suffixes :: Platform -> [String] -- the GHC-compiled code will run objish_suffixes platform = case platformOS platform of OSMinGW32 -> [ "o", "O", "obj", "OBJ" ] - _ -> [ "o" ] + _ -> [ "o", "dyn_o"] dynlib_suffixes :: Platform -> [String] dynlib_suffixes platform = case platformOS platform of ===================================== compiler/GHC/StgToCmm/Heap.hs ===================================== @@ -1,3 +1,4 @@ +{-# LANGUAGE OverloadedStrings #-} ----------------------------------------------------------------------------- -- -- Stg to C--: heap management functions @@ -44,7 +45,7 @@ import GHC.Types.Id ( Id ) import GHC.Unit import GHC.Platform import GHC.Platform.Profile -import GHC.Data.FastString( mkFastString, fsLit ) +import GHC.Data.FastString( FastString ) import GHC.Utils.Panic( sorry ) import Control.Monad (when) @@ -125,7 +126,7 @@ allocHeapClosure rep info_ptr use_cc payload = do -- ie 1 *before* the info-ptr word of new object. base <- getHpRelOffset info_offset - emitComment $ mkFastString "allocHeapClosure" + emitComment "allocHeapClosure" emitSetDynHdr base info_ptr use_cc -- Fill in the fields @@ -460,35 +461,41 @@ genericGC checkYield code call <- mkCall generic_gc (GC, GC) [] [] updfr_sz [] heapCheck False checkYield (call <*> mkBranch lretry) code +-- | Predefined ("canned") GC functions +-- +-- Functions have been added to cover 99% of the GC calls made in GHC and Cabal. +-- See #27142. cannedGCEntryPoint :: Platform -> [LocalReg] -> Maybe CmmExpr -cannedGCEntryPoint platform regs - = case map localRegType regs of - [] -> Just (mkGcLabel "stg_gc_noregs") - [ty] - | isGcPtrType ty -> Just (mkGcLabel "stg_gc_unpt_r1") - | isFloatType ty -> case width of - W32 -> Just (mkGcLabel "stg_gc_f1") - W64 -> Just (mkGcLabel "stg_gc_d1") - _ -> Nothing - - | width == wordWidth platform -> Just (mkGcLabel "stg_gc_unbx_r1") - | width == W64 -> Just (mkGcLabel "stg_gc_l1") - | otherwise -> Nothing - where - width = typeWidth ty - [ty1,ty2] - | isGcPtrType ty1 - && isGcPtrType ty2 -> Just (mkGcLabel "stg_gc_pp") - [ty1,ty2,ty3] - | isGcPtrType ty1 - && isGcPtrType ty2 - && isGcPtrType ty3 -> Just (mkGcLabel "stg_gc_ppp") - [ty1,ty2,ty3,ty4] - | isGcPtrType ty1 - && isGcPtrType ty2 - && isGcPtrType ty3 - && isGcPtrType ty4 -> Just (mkGcLabel "stg_gc_pppp") - _otherwise -> Nothing +cannedGCEntryPoint platform regs = + case map localRegType regs of + [] -> ret "stg_gc_noregs" + [ty] + | is_gc ty -> ret "stg_gc_unpt_r1" + | is_f32 ty -> ret "stg_gc_f1" + | is_f64 ty -> ret "stg_gc_d1" + | is_wn ty -> ret "stg_gc_unbx_r1" + | is_w64 ty -> ret "stg_gc_l1" + [ty1,ty2] + | is_gc ty1 && is_gc ty2 -> ret "stg_gc_pp" + | is_gc ty1 && is_wn ty2 -> ret "stg_gc_pi" + | is_wn ty1 && is_gc ty2 -> ret "stg_gc_ip" + | is_wn ty1 && is_wn ty2 -> ret "stg_gc_ii" + [ty1,ty2,ty3] + | is_gc ty1 && is_gc ty2 && is_gc ty3 -> ret "stg_gc_ppp" + | is_w8 ty1 && is_gc ty2 && is_gc ty3 -> ret "stg_gc_bpp" + [ty1,ty2,ty3,ty4] + | is_gc ty1 && is_gc ty2 && is_gc ty3 && is_gc ty4 -> ret "stg_gc_pppp" + [ty1,ty2,ty3,ty4,ty5] + | is_gc ty1 && is_gc ty2 && is_gc ty3 && is_gc ty4 && is_gc ty5 -> ret "stg_gc_ppppp" + _ -> Nothing + where + ret fs = Just (mkGcLabel fs) + is_gc ty = isGcPtrType ty + is_wn ty = isBitsType ty && typeWidth ty == wordWidth platform + is_w8 ty = isBitsType ty && typeWidth ty == W8 + is_w64 ty = isBitsType ty && typeWidth ty == W64 + is_f32 ty = isFloatType ty && typeWidth ty == W32 + is_f64 ty = isFloatType ty && typeWidth ty == W64 -- Note [stg_gc arguments] -- ~~~~~~~~~~~~~~~~~~~~~~~ @@ -514,8 +521,8 @@ generic_gc :: CmmExpr generic_gc = mkGcLabel "stg_gc_noregs" -- | Create a CLabel for calling a garbage collector entry point -mkGcLabel :: String -> CmmExpr -mkGcLabel s = CmmLit (CmmLabel (mkCmmCodeLabel rtsUnitId (fsLit s))) +mkGcLabel :: FastString -> CmmExpr +mkGcLabel s = CmmLit (CmmLabel (mkCmmCodeLabel rtsUnitId s)) ------------------------------- heapCheck :: Bool -> Bool -> CmmAGraph -> FCode a -> FCode a ===================================== rts/HeapStackCheck.cmm ===================================== @@ -373,8 +373,6 @@ stg_gc_l1 return (L_ l) jump stg_gc_noregs (stg_ret_l_info, l) (); } -/*-- Unboxed tuples with multiple pointers -------------------------------- */ - stg_gc_pp return (P_ arg1, P_ arg2) { call stg_gc_noregs(); @@ -393,6 +391,36 @@ stg_gc_pppp return (P_ arg1, P_ arg2, P_ arg3, P_ arg4) return (arg1,arg2,arg3,arg4); } +stg_gc_ppppp return (P_ arg1, P_ arg2, P_ arg3, P_ arg4, P_ arg5) +{ + call stg_gc_noregs(); + return (arg1,arg2,arg3,arg4,arg5); +} + +stg_gc_ip return (W_ arg1, P_ arg2) +{ + call stg_gc_noregs(); + return (arg1,arg2); +} + +stg_gc_pi return (P_ arg1, W_ arg2) +{ + call stg_gc_noregs(); + return (arg1,arg2); +} + +stg_gc_ii return (W_ arg1, W_ arg2) +{ + call stg_gc_noregs(); + return (arg1,arg2); +} + +stg_gc_bpp return (I8 arg1, P_ arg2, P_ arg3) +{ + call stg_gc_noregs(); + return (arg1,arg2,arg3); +} + /* ----------------------------------------------------------------------------- Generic function entry heap check code. ===================================== rts/RtsSymbols.c ===================================== @@ -499,6 +499,11 @@ extern char **environ; SymI_HasDataProto(stg_gc_pp) \ SymI_HasDataProto(stg_gc_ppp) \ SymI_HasDataProto(stg_gc_pppp) \ + SymI_HasDataProto(stg_gc_ppppp) \ + SymI_HasDataProto(stg_gc_ip) \ + SymI_HasDataProto(stg_gc_pi) \ + SymI_HasDataProto(stg_gc_ii) \ + SymI_HasDataProto(stg_gc_bpp) \ SymI_HasDataProto(__stg_gc_fun) \ SymI_HasDataProto(stg_gc_fun_info) \ SymI_HasDataProto(stg_yield_noregs) \ ===================================== rts/include/stg/MiscClosures.h ===================================== @@ -361,6 +361,11 @@ RTS_FUN_DECL(stg_gc_l1); RTS_FUN_DECL(stg_gc_pp); RTS_FUN_DECL(stg_gc_ppp); RTS_FUN_DECL(stg_gc_pppp); +RTS_FUN_DECL(stg_gc_ppppp); +RTS_FUN_DECL(stg_gc_ip); +RTS_FUN_DECL(stg_gc_pi); +RTS_FUN_DECL(stg_gc_ii); +RTS_FUN_DECL(stg_gc_bpp); RTS_RET(stg_gc_fun); RTS_FUN_DECL(__stg_gc_fun); ===================================== rts/posix/FdWakeup.c ===================================== @@ -0,0 +1,141 @@ +/* ----------------------------------------------------------------------------- + * + * (c) The GHC Team 2025 + * + * Utilities for a simple fd-based cross-thread wakeup mechanism. + * + * This is used to provide a mechanism to wake a thread when it is blocked + * waiting on fds and timeouts. The mechanism works by including the read end + * fd into the set of fds the thread waits on, and when a wake up is needed, + * the write end fd is used. + * + * This is implemented using either eventfd() or pipe(). + * + * Linux 2.6.22+ and FreeBSD 13+ support eventfd. It is a single fd with a + * 64bit counter. It uses fewer resources than a pipe (less memory and one + * rather than two fds), and is a tad faster (on the order of 5-10%). Using + * write() adds to the counter, while read() reads and resets it. Thus + * multiple writes are combined automatically into a single corresponding + * read. + * + * Otherwise we use a classic unix pipe. + * + * In both implementations, multiple sendFdWakeup notifcations (without + * interleaved collectFdWakeup) are combined to a single notification. This + * is automatic given the semantics of eventfd, while for pipe we implement + * it explicitly by draining the pipe in collectFdWakeup. + * + * -------------------------------------------------------------------------*/ + +#include "rts/PosixSource.h" +#include "Rts.h" + +#include "FdWakeup.h" + +#include <fcntl.h> +#include <unistd.h> + +#ifdef HAVE_SYS_EVENTFD_H +#include <sys/eventfd.h> +#endif + +#if !defined(HAVE_EVENTFD) \ + || (defined(HAVE_EVENTFD) && !(defined(EFD_CLOEXEC) && defined(EFD_NONBLOCK))) +static void fcntl_CLOEXEC_NONBLOCK(int fd) +{ + int res1 = fcntl(fd, F_SETFD, FD_CLOEXEC); + int res2 = fcntl(fd, F_SETFL, O_NONBLOCK); + if (RTS_UNLIKELY(res1 < 0 || res2 < 0)) { + sysErrorBelch("newFdWakeup fcntl()"); + stg_exit(EXIT_FAILURE); + } +} +#endif + +void newFdWakeup(int *wakeup_fd_r, int *wakeup_fd_w) +{ +#if defined(HAVE_EVENTFD) + int wakeup_fd; +#if defined(EFD_CLOEXEC) && defined(EFD_NONBLOCK) + wakeup_fd = eventfd(0, EFD_CLOEXEC | EFD_NONBLOCK); +#else + wakeup_fd = eventfd(0, 0); + if (wakeup_fd >= 0) fcntl_CLOEXEC_NONBLOCK(wakeup_fd); +#endif + if (RTS_UNLIKELY(wakeup_fd < 0)) { + sysErrorBelch("newFdWakeup eventfd()"); + stg_exit(EXIT_FAILURE); + } + /* eventfd uses the same fd for each end */ + *wakeup_fd_r = wakeup_fd; + *wakeup_fd_w = wakeup_fd; +#else + int pipefd[2]; + int res; + res = pipe(pipefd); + if (RTS_UNLIKELY(res < 0)) { + sysErrorBelch("newFdWakeup pipe"); + stg_exit(EXIT_FAILURE); + } + fcntl_CLOEXEC_NONBLOCK(pipefd[0]); + fcntl_CLOEXEC_NONBLOCK(pipefd[1]); + *wakeup_fd_r = pipefd[0]; /* read end */ + *wakeup_fd_w = pipefd[1]; /* write end */ +#endif +} + +void closeFdWakeup(int wakeup_fd_r, int wakeup_fd_w) +{ +#if defined(HAVE_EVENTFD) + ASSERT(wakeup_fd_r == wakeup_fd_w); + close(wakeup_fd_r); +#else + ASSERT(wakeup_fd_r != wakeup_fd_w); + close(wakeup_fd_r); + close(wakeup_fd_w); +#endif +} + +/* This is safe to use from a signal handler. Using write() to a pipe + * or eventfd is fine. */ +void sendFdWakeup(int wakeup_fd_w) +{ + int res; +#if defined(HAVE_EVENTFD) + uint64_t val = 1; + res = write(wakeup_fd_w, &val, 8); +#else + unsigned char buf = 1; + res = write(wakeup_fd_w, &buf, 1); +#endif + if (RTS_UNLIKELY(res < 0)) { + /* Unlikely the pipe buffer will fill, but it would not be an error. */ + if (errno == EAGAIN) return; + sysErrorBelch("sendFdWakeup write"); + stg_exit(EXIT_FAILURE); + } +} + +void collectFdWakeup(int wakeup_fd_r) +{ + int res; +#if defined(HAVE_EVENTFD) + uint64_t buf; + /* eventfd combines events into one counter, so a single read is enough */ + res = read(wakeup_fd_r, &buf, 8); +#else + /* Drain the pipe buffer. Multiple wakeup notifications could + * have been sent before we have a chance to collect them. + */ + uint64_t buf; + do { + res = read(wakeup_fd_r, &buf, 8); + } while (res == 8); +#endif + if (RTS_UNLIKELY(res < 0)) { + /* After the first pipe read, it could block */ + if (errno == EAGAIN) return; + sysErrorBelch("collectFdWakeup read"); + stg_exit(EXIT_FAILURE); + } +} ===================================== rts/posix/FdWakeup.h ===================================== @@ -0,0 +1,40 @@ +/* ----------------------------------------------------------------------------- + * + * (c) The GHC Team 2025 + * + * Utilities for a simple fd-based cross-thread wakeup mechanism. + * + * It provides a mechanism for a thread that block on fds to add a simple + * wakeup/notification feature. + * + * Start with newFdWakeup, and pass the fd_r to the thread that needs the + * wakeup feature. The thread that needs to be woken should include the fd_r + * into the set of fds that the thread waits on (e.g. using poll or similar). + * If this fd becomes ready for read, the thread must call collectFdWakeup, + * and when a wake up is needed, the write end fd is used. In any other thread + * (or in a signal handler), call sendFdWakeup(fd_w) to (asynchronously) cause + * the wakeup. + * + * There is no message payload. Multiple wakeups may be combined (if they're + * sent multiple times before the notified thread can wake and call + * collectFdWakeup). + * + * The implementation uses pipe() or eventfd() on supported OSs. + * + * Prototypes for functions in FdWakeup.c + * + * -------------------------------------------------------------------------*/ + +#pragma once + +#include "BeginPrivate.h" + +void newFdWakeup(int *fd_r, int *fd_w); +void closeFdWakeup(int fd_r, int fd_w); + +/* This is safe to use from a signal handler */ +void sendFdWakeup(int fd_w); +void collectFdWakeup(int fd_r); + +#include "EndPrivate.h" + ===================================== rts/posix/Ticker.c ===================================== @@ -1,19 +1,53 @@ /* ----------------------------------------------------------------------------- * - * (c) The GHC Team, 1995-2007 + * (c) The GHC Team, 1995-2026 * - * Posix implementation(s) of the interval timer for profiling and pre-emptive - * scheduling. + * The posix implementation of the interval timer, used for pre-emptive + * scheduling of Haskell threads, and for sample based profiling. + * + * This file defines the "ticker": the platform-specific service to install and + * run the timer. See rts/Timer.c for the platform-dependent view of interval + * timing. * * ---------------------------------------------------------------------------*/ -/* The interval timer is used for profiling and for context switching. - * This file defines the platform-specific services to install and run the - * timers, and we call this the ticker. See rts/Timer.c for the - * platform-dependent view of interval timing. +/* This implementation uses a posix thread which repeatedly blocks on a timeout + * using either the ppoll() or select() API. This lets it also block on a file + * descriptor for early wakeup. + * + * The design uses a simple relative time delay with no catchup. That is, time + * spent by the ticker thread itself (e.g. flushing eventlog buffers) is not + * accounted for, and the next tick is delayed by that much (modulo wakeup + * jitter). This is probably the right thing to do: generally in realtime + * systems one does not want to try to catch up when behind, since that tends + * towards oversubscribing resources. Graceful degredation is usually + * preferable. + * + * Experimental results (on Linux 6.18 on x86-64) to measure the typical + * difference between the requested wakeup time and actual wakeup time for + * different delay intervals: + * + * interval typical actual wakeup time after due time + * 10000us 340 -- 400us (this is the default interval) + * 1000us 55 -- 100us + * 100us 55us + * 10us 55us + * + * While there's quite a bit of variance to these numbers, the results do not + * vary significantly between using select, ppoll or nanosleep. + * + * On Linux at least, for longer delays the kernel allows itself lower wakeup + * accuracy (which allows it to save power by coalescing multiple wakeups). + * Similarly, the reason for 55us on the low end is that the default thread + * timer slack on Linux is 50us, and context switch time accounts for the + * remainder. + * + * In conclusion, on Linux at least, the accuracy is fine, both for the + * default interval (10ms, 10000us) and for shorter intervals used during + * profiling. * * Historically we had ticker implementations using signals. This was always a - * rather shakey thing to do but we had few alternatives. + * rather shakey thing to do but we originally had few alternatives. * - One problem with using signals is that there are severe limits on what * code can be called from signal handlers. In particular it's not possible * to take locks in a signal handler contex. This was enough for contex @@ -23,17 +57,245 @@ * calls (#10840) or can be overwritten by user code. */ -/* Select a ticker implementation to use: - * - * On modern Linux, FreeBSD and NetBSD we can use timerfd_create and a thread - * that waits on it using poll. Linux has had timerfd since version 2.6.25. - * NetBSD has had timerfd since version 10, and FreeBSD since version 15. - * - * For older version of linux/bsd without timerfd, and for all other posix - * platforms, we use the implementation using posix pthreads and nanosleep(). +#include "rts/PosixSource.h" +#include "Rts.h" + +#include "Ticker.h" +#include "RtsUtils.h" +#include "Proftimer.h" +#include "Schedule.h" +#include "posix/Clock.h" +#include "posix/FdWakeup.h" + +#if defined(HAVE_DECL_PPOLL) && HAVE_DECL_PPOLL == 1 +/* We prefer the ppoll() function if available since it allows sanely waiting + * on a single fd with precise timeouts (nanosecond precision). It is not in + * the posix standard however and some platforms (notably glibc and freebsd) + * need special CPP defines to make it available: + */ +#define _GNU_SOURCE 1 +#define __BSD_VISIBLE 1 +#include <signal.h> +#include <poll.h> +#else +/* Otherwise we use the classic select(), which does have microsecond + * precision, but requires we build three whole 1024 bit (128 byte) fd sets + * just to wait on one fd. */ -#if defined(HAVE_SYS_TIMERFD_H) -#include "ticker/TimerFd.c" +#include <sys/select.h> +#endif + +#include <time.h> +#if HAVE_SYS_TIME_H +# include <sys/time.h> +#endif + +#if defined(HAVE_SIGNAL_H) +# include <signal.h> +#endif + +#include <string.h> + +#include <pthread.h> +#if defined(HAVE_PTHREAD_NP_H) +#include <pthread_np.h> +#endif +#include <unistd.h> +#include <fcntl.h> + +static Time itimer_interval = DEFAULT_TICK_INTERVAL; + +// Should we be firing ticks? +// Writers to this must hold the mutex below. +static bool stopped = false; + +// should the ticker thread exit? +// This can be set without holding the mutex. +static bool exited = true; + +// Signaled when we want to (re)start the timer +static Condition start_cond; +static Mutex mutex; +static OSThreadId thread; + +// fds for interrupting the ticker +static int interruptfd_r = -1, interruptfd_w = -1; + +static void *itimer_thread_func(void *_handle_tick) +{ + TickProc handle_tick = _handle_tick; + +#if defined(HAVE_DECL_PPOLL) && HAVE_DECL_PPOLL == 1 + struct pollfd pollfds[1]; + + pollfds[0].fd = interruptfd_r; + pollfds[0].events = POLLIN; + + struct timespec ts = { .tv_sec = TimeToSeconds(itimer_interval) + , .tv_nsec = TimeToNS(itimer_interval) % 1000000000 + }; #else -#include "ticker/Pthread.c" + fd_set selectfds; + FD_ZERO(&selectfds); + FD_SET(interruptfd_r, &selectfds); + + struct timeval tv = { .tv_sec = TimeToSeconds(itimer_interval) + /* convert remainder time in nanoseconds + to microseconds, rounding up: */ + , .tv_usec = ((TimeToNS(itimer_interval) % 1000000000) + + 999) / 1000 + }; +#endif + + // Relaxed is sufficient: If we don't see that exited was set in one iteration we will + // see it next time. + while (!RELAXED_LOAD_ALWAYS(&exited)) { + +#if defined(HAVE_DECL_PPOLL) && HAVE_DECL_PPOLL == 1 + int nfds = 1; + int nready = ppoll(pollfds, nfds, &ts, NULL); +#else + struct timeval tv_tmp = tv; // copy since select may change this value. + int nfds = interruptfd_r+1; + int nready = select(nfds, &selectfds, NULL, NULL, &tv_tmp); +#endif + // In either case (ppoll or select), the result nready is the number + // of fds that are ready. + if (RTS_LIKELY(nready == 0)) { + // Timer expired, not interrupted, continue. + } else if (nready > 0) { + // We only monitor one fd (the interruptfd_r), so we know + // it is that fd that is ready without any further checks. + collectFdWakeup(interruptfd_r); + // No further action needed, continue on to handling the final tick + // and then stop. + + // Note that we rely on sendFdWakeup and select/poll to provide the + // happens-before relation. So if 'exited' was set before calling + // sendFdWakeup, then we should be able to reliably read it after. + // And thus reading 'exited' in the while loop guard is ok. + } else { + // While the RTS attempts to mask signals, some foreign libraries + // that rely on signal delivery may unmask them. Consequently we + // may see EINTR. See #24610. + if (errno != EINTR) { + sysErrorBelch("Ticker: poll failed: %s", strerror(errno)); + } + } + + // first try a cheap test + if (RELAXED_LOAD_ALWAYS(&stopped)) { + OS_ACQUIRE_LOCK(&mutex); + // should we really stop? + if (stopped) { + waitCondition(&start_cond, &mutex); + } + OS_RELEASE_LOCK(&mutex); + } else { + handle_tick(0); + } + } + + return NULL; +} + +void +initTicker (Time interval, TickProc handle_tick) +{ + itimer_interval = interval; + stopped = true; + exited = false; +#if defined(HAVE_SIGNAL_H) + sigset_t mask, omask; + int sigret; +#endif + int ret; + + initCondition(&start_cond); + initMutex(&mutex); + + /* Open the interrupt fd synchronously. + * + * We used to do it in itimer_thread_func (i.e. in the timer thread) but it + * meant that some user code could run before it and get confused by the + * allocation of the timerfd. + * + * See hClose002 which unsafely closes a file descriptor twice expecting an + * exception the second time: it sometimes failed when the second call to + * "close" closed our own timerfd which inadvertently reused the same file + * descriptor closed by the first call! (see #20618) + */ + + if (interruptfd_r != -1) { + // don't leak the old file descriptors after a fork (#25280) + closeFdWakeup(interruptfd_r, interruptfd_w); + } + newFdWakeup(&interruptfd_r, &interruptfd_w); + + /* + * Create the thread with all blockable signals blocked, leaving signal + * handling to the main and/or other threads. This is especially useful in + * the non-threaded runtime, where applications might expect sigprocmask(2) + * to effectively block signals. + */ +#if defined(HAVE_SIGNAL_H) + sigfillset(&mask); + sigret = pthread_sigmask(SIG_SETMASK, &mask, &omask); +#endif + ret = createAttachedOSThread(&thread, "ghc_ticker", itimer_thread_func, (void*)handle_tick); +#if defined(HAVE_SIGNAL_H) + if (sigret == 0) + pthread_sigmask(SIG_SETMASK, &omask, NULL); #endif + + if (ret != 0) { + barf("Ticker: Failed to spawn thread: %s", strerror(errno)); + } +} + +void +startTicker(void) +{ + OS_ACQUIRE_LOCK(&mutex); + RELAXED_STORE(&stopped, false); + signalCondition(&start_cond); + OS_RELEASE_LOCK(&mutex); +} + +/* There may be at most one additional tick fired after a call to this */ +void +stopTicker(void) +{ + OS_ACQUIRE_LOCK(&mutex); + RELAXED_STORE(&stopped, true); + OS_RELEASE_LOCK(&mutex); +} + +/* There may be at most one additional tick fired after a call to this */ +void +exitTicker (bool wait) +{ + ASSERT(!SEQ_CST_LOAD(&exited)); + SEQ_CST_STORE(&exited, true); + // ensure that ticker wakes up if stopped + startTicker(); + sendFdWakeup(interruptfd_w); + + // wait for ticker to terminate if necessary + if (wait) { + if (pthread_join(thread, NULL)) { + sysErrorBelch("Ticker: Failed to join: %s", strerror(errno)); + } + closeFdWakeup(interruptfd_r, interruptfd_w); + closeMutex(&mutex); + closeCondition(&start_cond); + } else { + pthread_detach(thread); + } +} + +int +rtsTimerSignal(void) +{ + return SIGALRM; +} ===================================== rts/posix/ticker/Pthread.c deleted ===================================== @@ -1,195 +0,0 @@ -/* ----------------------------------------------------------------------------- - * - * (c) The GHC Team, 1995-2007 - * - * Interval timer for profiling and pre-emptive scheduling. - * - * ---------------------------------------------------------------------------*/ - -/* - * We use a realtime timer by default. I found this much more - * reliable than a CPU timer: - * - * Experiments with different frequencies: using - * CLOCK_REALTIME/CLOCK_MONOTONIC on Linux 2.6.32, - * 1000us has <1% impact on runtime - * 100us has ~2% impact on runtime - * 10us has ~40% impact on runtime - * - * using CLOCK_PROCESS_CPUTIME_ID on Linux 2.6.32, - * I cannot get it to tick faster than 10ms (10000us) - * which isn't great for profiling. - * - * In the threaded RTS, we can't tick in CPU time because the thread - * which has the virtual timer might be idle, so the tick would never - * fire. Therefore we used to tick in realtime in the threaded RTS and - * in CPU time otherwise, but now we always tick in realtime, for - * several reasons: - * - * - resolution (see above) - * - consistency (-threaded is the same as normal) - * - more consistency: Windows only has a realtime timer - * - * Note we want to use CLOCK_MONOTONIC rather than CLOCK_REALTIME, - * because the latter may jump around (NTP adjustments, leap seconds - * etc.). - */ - -#include "rts/PosixSource.h" -#include "Rts.h" - -#include "Ticker.h" -#include "RtsUtils.h" -#include "Proftimer.h" -#include "Schedule.h" -#include "posix/Clock.h" -#include <poll.h> - -#include <time.h> -#if HAVE_SYS_TIME_H -# include <sys/time.h> -#endif - -#if defined(HAVE_SIGNAL_H) -# include <signal.h> -#endif - -#include <string.h> - -#include <pthread.h> -#if defined(HAVE_PTHREAD_NP_H) -#include <pthread_np.h> -#endif -#include <unistd.h> -#include <fcntl.h> - -/* - * TFD_CLOEXEC has been added in Linux 2.6.26. - * If it is not available, we use fcntl(F_SETFD). - */ -#if !defined(TFD_CLOEXEC) -#define TFD_CLOEXEC 0 -#endif - -static Time itimer_interval = DEFAULT_TICK_INTERVAL; - -// Should we be firing ticks? -// Writers to this must hold the mutex below. -static bool stopped = false; - -// should the ticker thread exit? -// This can be set without holding the mutex. -static bool exited = true; - -// Signaled when we want to (re)start the timer -static Condition start_cond; -static Mutex mutex; -static OSThreadId thread; - -static void *itimer_thread_func(void *_handle_tick) -{ - TickProc handle_tick = _handle_tick; - - // Relaxed is sufficient: If we don't see that exited was set in one iteration we will - // see it next time. - while (!RELAXED_LOAD_ALWAYS(&exited)) { - if (rtsSleep(itimer_interval) != 0) { - sysErrorBelch("Ticker: sleep failed: %s", strerror(errno)); - } - - // first try a cheap test - if (RELAXED_LOAD_ALWAYS(&stopped)) { - OS_ACQUIRE_LOCK(&mutex); - // should we really stop? - if (stopped) { - waitCondition(&start_cond, &mutex); - } - OS_RELEASE_LOCK(&mutex); - } else { - handle_tick(0); - } - } - - return NULL; -} - -void -initTicker (Time interval, TickProc handle_tick) -{ - itimer_interval = interval; - stopped = true; - exited = false; -#if defined(HAVE_SIGNAL_H) - sigset_t mask, omask; - int sigret; -#endif - int ret; - - initCondition(&start_cond); - initMutex(&mutex); - - /* - * Create the thread with all blockable signals blocked, leaving signal - * handling to the main and/or other threads. This is especially useful in - * the non-threaded runtime, where applications might expect sigprocmask(2) - * to effectively block signals. - */ -#if defined(HAVE_SIGNAL_H) - sigfillset(&mask); - sigret = pthread_sigmask(SIG_SETMASK, &mask, &omask); -#endif - ret = createAttachedOSThread(&thread, "ghc_ticker", itimer_thread_func, (void*)handle_tick); -#if defined(HAVE_SIGNAL_H) - if (sigret == 0) - pthread_sigmask(SIG_SETMASK, &omask, NULL); -#endif - - if (ret != 0) { - barf("Ticker: Failed to spawn thread: %s", strerror(errno)); - } -} - -void -startTicker(void) -{ - OS_ACQUIRE_LOCK(&mutex); - RELAXED_STORE(&stopped, false); - signalCondition(&start_cond); - OS_RELEASE_LOCK(&mutex); -} - -/* There may be at most one additional tick fired after a call to this */ -void -stopTicker(void) -{ - OS_ACQUIRE_LOCK(&mutex); - RELAXED_STORE(&stopped, true); - OS_RELEASE_LOCK(&mutex); -} - -/* There may be at most one additional tick fired after a call to this */ -void -exitTicker (bool wait) -{ - ASSERT(!SEQ_CST_LOAD(&exited)); - SEQ_CST_STORE(&exited, true); - // ensure that ticker wakes up if stopped - startTicker(); - - // wait for ticker to terminate if necessary - if (wait) { - if (pthread_join(thread, NULL)) { - sysErrorBelch("Ticker: Failed to join: %s", strerror(errno)); - } - closeMutex(&mutex); - closeCondition(&start_cond); - } else { - pthread_detach(thread); - } -} - -int -rtsTimerSignal(void) -{ - return SIGALRM; -} ===================================== rts/posix/ticker/TimerFd.c deleted ===================================== @@ -1,291 +0,0 @@ -/* ----------------------------------------------------------------------------- - * - * (c) The GHC Team, 1995-2023 - * - * Interval timer for profiling and pre-emptive scheduling. - * - * ---------------------------------------------------------------------------*/ - -/* - * We use a realtime timer by default. I found this much more - * reliable than a CPU timer: - * - * Experiments with different frequencies: using - * CLOCK_REALTIME/CLOCK_MONOTONIC on Linux 2.6.32, - * 1000us has <1% impact on runtime - * 100us has ~2% impact on runtime - * 10us has ~40% impact on runtime - * - * using CLOCK_PROCESS_CPUTIME_ID on Linux 2.6.32, - * I cannot get it to tick faster than 10ms (10000us) - * which isn't great for profiling. - * - * In the threaded RTS, we can't tick in CPU time because the thread - * which has the virtual timer might be idle, so the tick would never - * fire. Therefore we used to tick in realtime in the threaded RTS and - * in CPU time otherwise, but now we always tick in realtime, for - * several reasons: - * - * - resolution (see above) - * - consistency (-threaded is the same as normal) - * - more consistency: Windows only has a realtime timer - * - * Note we want to use CLOCK_MONOTONIC rather than CLOCK_REALTIME, - * because the latter may jump around (NTP adjustments, leap seconds - * etc.). - */ - -#include "rts/PosixSource.h" -#include "Rts.h" - -#include "Ticker.h" -#include "RtsUtils.h" -#include "Proftimer.h" -#include "Schedule.h" -#include "posix/Clock.h" -#include <poll.h> - -#include <time.h> -#if HAVE_SYS_TIME_H -# include <sys/time.h> -#endif - -#if defined(HAVE_SIGNAL_H) -# include <signal.h> -#endif - -#include <string.h> - -#include <pthread.h> -#if defined(HAVE_PTHREAD_NP_H) -#include <pthread_np.h> -#endif -#include <unistd.h> -#include <fcntl.h> - -#include <sys/timerfd.h> - - -/* - * TFD_CLOEXEC has been added in Linux 2.6.26. - * If it is not available, we use fcntl(F_SETFD). - */ -#if !defined(TFD_CLOEXEC) -#define TFD_CLOEXEC 0 -#endif - -static Time itimer_interval = DEFAULT_TICK_INTERVAL; - -// Should we be firing ticks? -// Writers to this must hold the mutex below. -static bool stopped = false; - -// should the ticker thread exit? -// This can be set without holding the mutex. -static bool exited = true; - -// Signaled when we want to (re)start the timer -static Condition start_cond; -static Mutex mutex; -static OSThreadId thread; - -// file descriptor for the timer (Linux only) -static int timerfd = -1; - -// pipe for signaling exit -static int pipefds[2]; - -static void *itimer_thread_func(void *_handle_tick) -{ - TickProc handle_tick = _handle_tick; - uint64_t nticks; - ssize_t r = 0; - struct pollfd pollfds[2]; - - pollfds[0].fd = pipefds[0]; - pollfds[0].events = POLLIN; - pollfds[1].fd = timerfd; - pollfds[1].events = POLLIN; - - // Relaxed is sufficient: If we don't see that exited was set in one iteration we will - // see it next time. - while (!RELAXED_LOAD_ALWAYS(&exited)) { - if (poll(pollfds, 2, -1) == -1) { - // While the RTS attempts to mask signals, some foreign libraries - // may rely on signal delivery may unmask them. Consequently we may - // see EINTR. See #24610. - if (errno != EINTR) { - sysErrorBelch("Ticker: poll failed: %s", strerror(errno)); - } - } - - // We check the pipe first, even though the timerfd may also have triggered. - if (pollfds[0].revents & POLLIN) { - // the pipe is ready for reading, the only possible reason is that we're exiting - exited = true; // set this again to make sure even RELAXED_LOAD will read the proper value - // no further action needed, skip ahead to handling the final tick and then stopping - } - else if (pollfds[1].revents & POLLIN) { // the timerfd is ready for reading - r = read(timerfd, &nticks, sizeof(nticks)); // this should never block now - - if ((r == 0) && (errno == 0)) { - /* r == 0 is expected only for non-blocking fd (in which case - * errno should be EAGAIN) but we use a blocking fd. - * - * Due to a kernel bug (cf https://lkml.org/lkml/2019/8/16/335) - * on some platforms we could see r == 0 and errno == 0. - */ - IF_DEBUG(scheduler, debugBelch("read(timerfd) returned 0 with errno=0. This is a known kernel bug. We just ignore it.")); - } - else if (r != sizeof(nticks) && errno != EINTR) { - barf("Ticker: read(timerfd) failed with %s and returned %zd", strerror(errno), r); - } - } - - // first try a cheap test - if (RELAXED_LOAD_ALWAYS(&stopped)) { - OS_ACQUIRE_LOCK(&mutex); - // should we really stop? - if (stopped) { - waitCondition(&start_cond, &mutex); - } - OS_RELEASE_LOCK(&mutex); - } else { - handle_tick(0); - } - } - - close(timerfd); - return NULL; -} - -void -initTicker (Time interval, TickProc handle_tick) -{ - itimer_interval = interval; - stopped = true; - exited = false; -#if defined(HAVE_SIGNAL_H) - sigset_t mask, omask; - int sigret; -#endif - int ret; - - initCondition(&start_cond); - initMutex(&mutex); - - /* Open the file descriptor for the timer synchronously. - * - * We used to do it in itimer_thread_func (i.e. in the timer thread) but it - * meant that some user code could run before it and get confused by the - * allocation of the timerfd. - * - * See hClose002 which unsafely closes a file descriptor twice expecting an - * exception the second time: it sometimes failed when the second call to - * "close" closed our own timerfd which inadvertently reused the same file - * descriptor closed by the first call! (see #20618) - */ - struct itimerspec it; - it.it_value.tv_sec = TimeToSeconds(itimer_interval); - it.it_value.tv_nsec = TimeToNS(itimer_interval) % 1000000000; - it.it_interval = it.it_value; - - if (timerfd != -1) { - // don't leak the old file descriptors after a fork (#25280) - close(timerfd); - close(pipefds[0]); - close(pipefds[1]); - timerfd = -1; - } - - timerfd = timerfd_create(CLOCK_MONOTONIC, TFD_CLOEXEC); - if (timerfd == -1) { - barf("timerfd_create: %s", strerror(errno)); - } - if (!TFD_CLOEXEC) { - fcntl(timerfd, F_SETFD, FD_CLOEXEC); - } - if (timerfd_settime(timerfd, 0, &it, NULL)) { - barf("timerfd_settime: %s", strerror(errno)); - } - - if (pipe(pipefds) < 0) { - barf("pipe: %s", strerror(errno)); - } - - /* - * Create the thread with all blockable signals blocked, leaving signal - * handling to the main and/or other threads. This is especially useful in - * the non-threaded runtime, where applications might expect sigprocmask(2) - * to effectively block signals. - */ -#if defined(HAVE_SIGNAL_H) - sigfillset(&mask); - sigret = pthread_sigmask(SIG_SETMASK, &mask, &omask); -#endif - ret = createAttachedOSThread(&thread, "ghc_ticker", itimer_thread_func, (void*)handle_tick); -#if defined(HAVE_SIGNAL_H) - if (sigret == 0) - pthread_sigmask(SIG_SETMASK, &omask, NULL); -#endif - - if (ret != 0) { - barf("Ticker: Failed to spawn thread: %s", strerror(errno)); - } -} - -void -startTicker(void) -{ - OS_ACQUIRE_LOCK(&mutex); - RELAXED_STORE(&stopped, false); - signalCondition(&start_cond); - OS_RELEASE_LOCK(&mutex); -} - -/* There may be at most one additional tick fired after a call to this */ -void -stopTicker(void) -{ - OS_ACQUIRE_LOCK(&mutex); - RELAXED_STORE(&stopped, true); - OS_RELEASE_LOCK(&mutex); -} - -/* There may be at most one additional tick fired after a call to this */ -void -exitTicker (bool wait) -{ - ASSERT(!SEQ_CST_LOAD(&exited)); - SEQ_CST_STORE(&exited, true); - // ensure that ticker wakes up if stopped - startTicker(); - - // wait for ticker to terminate if necessary - if (wait) { - // write anything to the pipe to trigger poll() in the ticker thread - if (write(pipefds[1], "stop", 5) < 0) { - sysErrorBelch("Ticker: Failed to write to pipe: %s", strerror(errno)); - } - - if (pthread_join(thread, NULL)) { - sysErrorBelch("Ticker: Failed to join: %s", strerror(errno)); - } - - // These need to happen AFTER the ticker thread has finished to prevent a race condition - // where the ticker thread closes the read end of the pipe before we're done writing to it. - close(pipefds[0]); - close(pipefds[1]); - - closeMutex(&mutex); - closeCondition(&start_cond); - } else { - pthread_detach(thread); - } -} - -int -rtsTimerSignal(void) -{ - return SIGALRM; -} ===================================== rts/rts.cabal ===================================== @@ -582,11 +582,9 @@ library posix/Ticker.c posix/OSMem.c posix/OSThreads.c + posix/FdWakeup.c posix/Poll.c posix/Select.c posix/Signals.c posix/Timeout.c posix/TTY.c - -- ticker/*.c - -- We don't want to compile posix/ticker/*.c, these will be #included - -- from Ticker.c ===================================== testsuite/driver/testlib.py ===================================== @@ -3043,6 +3043,12 @@ def normalise_errmsg(s: str) -> str: # Old emcc warns when we export HEAP8 but new one requires it (see #26290) s = s.replace('warning: invalid item in EXPORTED_RUNTIME_METHODS: HEAP8\nwarning: invalid item in EXPORTED_RUNTIME_METHODS: HEAPU8\nemcc: warning: warnings in JS library compilation [-Wjs-compiler]\n','') + # on newer versions of MacOS X, the shipped ranlib warns about object files with no symbols, + # however, these are completely benign stubs. + # See https://gitlab.haskell.org/ghc/ghc/-/issues/27116 + if opsys('darwin'): + s = modify_lines(s, lambda l: re.sub(r'.*ranlib:.*has no symbols', '', l)) + return s # normalise a .prof file, so that we can reasonably compare it against ===================================== testsuite/tests/driver/all.T ===================================== @@ -120,9 +120,7 @@ if config.os == 'darwin': else: only_darwin = skip -test('static001', [extra_files(['Static001.hs']), - only_darwin, - when(arch('x86_64'), expect_broken(8127))], +test('static001', [extra_files(['Static001.hs']), only_darwin], makefile_test, ['static001']) test('dynHelloWorld', ===================================== testsuite/tests/driver/bytecode-object/Makefile ===================================== @@ -159,3 +159,9 @@ bytecode_object25: "$(TEST_HC)" $(TEST_HC_OPTS) -c BytecodeForeign.hs -fbyte-code -fwrite-byte-code -fwrite-interface $(ghciWayFlags) "$(TEST_HC)" $(TEST_HC_OPTS_INTERACTIVE) -v1 -fno-hide-source-paths -fbyte-code -fwrite-byte-code -fwrite-interface BytecodeForeign.hs -e "testForeign" +# Test that corrupt bytecode file headers are rejected clearly. +bytecode_object26: + "$(TEST_HC)" $(TEST_HC_OPTS) -c BytecodeTest.hs -fbyte-code -fwrite-byte-code + @printf 'bad!' | dd of=BytecodeTest.gbc bs=1 count=4 conv=notrunc 2>/dev/null + ! "$(TEST_HC)" $(TEST_HC_OPTS) -c -bytecodelib -o linked.bytecode BytecodeTest.gbc 2> bytecode_object26.stderr + @grep -F "bytecode file header mismatch" bytecode_object26.stderr >/dev/null ===================================== testsuite/tests/driver/bytecode-object/all.T ===================================== @@ -26,3 +26,4 @@ test('bytecode_object22', bytecode_opts, makefile_test, ['bytecode_object22']) test('bytecode_object23', bytecode_opts, makefile_test, ['bytecode_object23']) test('bytecode_object24', bytecode_opts + [copy_files], makefile_test, ['bytecode_object24']) test('bytecode_object25', [bytecode_opts, req_interp, extra_files(['BytecodeForeign.hs', 'BytecodeForeign.c'])], makefile_test, ['bytecode_object25']) +test('bytecode_object26', [bytecode_opts], makefile_test, ['bytecode_object26']) ===================================== testsuite/tests/plugins/Makefile ===================================== @@ -238,3 +238,10 @@ test-late-plugin: .PHONY: T21730 T21730: "$(TEST_HC)" $(TEST_HC_OPTS) $(ghcPluginWayFlags) -v0 T21730.hs -package-db T21730-plugin/pkg.T21730-plugin/local.package.conf + +# Test that .dyn_o files are accepted as valid object files on the command line +# without producing "ignoring unrecognised input" warnings (#24486) +.PHONY: T24486 +T24486: + "$(TEST_HC)" $(TEST_HC_OPTS) -v0 -c T24486_Helper.hs -osuf dyn_o + "$(TEST_HC)" $(TEST_HC_OPTS) $(ghcPluginWayFlags) -v0 T24486.hs T24486_Helper.dyn_o -package-db T24486-plugin/pkg.T24486-plugin/local.package.conf -fplugin T24486_Plugin -plugin-package T24486-plugin ===================================== testsuite/tests/plugins/T24486-plugin/Makefile ===================================== @@ -0,0 +1,18 @@ +TOP=../../.. +include $(TOP)/mk/boilerplate.mk +include $(TOP)/mk/test.mk + +clean.%: + rm -rf pkg.$* + +HERE := $(abspath .) +$(eval $(call canonicalise,HERE)) + +package.%: + $(MAKE) -s --no-print-directory clean.$* + mkdir pkg.$* + "$(TEST_HC)" -outputdir pkg.$* --make -v0 -o pkg.$*/setup Setup.hs + "$(GHC_PKG)" init pkg.$*/local.package.conf + pkg.$*/setup configure --distdir pkg.$*/dist -v0 $(CABAL_PLUGIN_BUILD) --prefix="$(HERE)/pkg.$*/install" --with-compiler="$(TEST_HC)" --with-hc-pkg="$(GHC_PKG)" --package-db=pkg.$*/local.package.conf $(if $(findstring YES,$(HAVE_PROFILING)), --enable-library-profiling) + pkg.$*/setup build --distdir pkg.$*/dist -v0 + pkg.$*/setup install --distdir pkg.$*/dist -v0 ===================================== testsuite/tests/plugins/T24486-plugin/Setup.hs ===================================== @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain ===================================== testsuite/tests/plugins/T24486-plugin/T24486-plugin.cabal ===================================== @@ -0,0 +1,9 @@ +Name: T24486-plugin +Version: 0.1 +Synopsis: For testing +Cabal-Version: >= 1.2 +Build-Type: Simple + +Library + Build-Depends: base, ghc + Exposed-Modules: T24486_Plugin ===================================== testsuite/tests/plugins/T24486-plugin/T24486_Plugin.hs ===================================== @@ -0,0 +1,6 @@ +module T24486_Plugin (plugin) where + +import GHC.Plugins + +plugin :: Plugin +plugin = defaultPlugin ===================================== testsuite/tests/plugins/T24486.hs ===================================== @@ -0,0 +1,4 @@ +module Main where + +main :: IO () +main = return () ===================================== testsuite/tests/plugins/T24486_Helper.hs ===================================== @@ -0,0 +1,4 @@ +module T24486_Helper where + +helper :: Int +helper = 42 ===================================== testsuite/tests/plugins/all.T ===================================== @@ -395,3 +395,10 @@ test('T21730', pre_cmd('$MAKE -s --no-print-directory -C T21730-plugin package.T21730-plugin TOP={top}') ], makefile_test, []) + +test('T24486', + [extra_files(['T24486-plugin/', 'T24486_Helper.hs']), + when(opsys('mingw32'), skip), + pre_cmd('$MAKE -s --no-print-directory -C T24486-plugin package.T24486-plugin TOP={top}') + ], + makefile_test, []) ===================================== testsuite/tests/runghc/Makefile ===================================== @@ -23,6 +23,11 @@ T11247: -'$(RUNGHC)' foo. -'$(RUNGHC)' foo.bar +# runghc should honour -osuf for dependencies too (#16145). +T16145: + '$(RUNGHC)' -- -fobject-code -osuf=hs.o T16145 + printf '%s\n' *.hi *.o *.hs | LC_ALL=C sort + T17171a: '$(RUNGHC)' --ghc-arg=-Wall T17171a.hs T17171b: ===================================== testsuite/tests/runghc/T16145.hs ===================================== @@ -0,0 +1,5 @@ +module T16145 where + +import T16145_aux + +main = g ===================================== testsuite/tests/runghc/T16145.stdout ===================================== @@ -0,0 +1,6 @@ +T16145.hi +T16145.hs +T16145.hs.o +T16145_aux.hi +T16145_aux.hs +T16145_aux.hs.o ===================================== testsuite/tests/runghc/T16145_aux.hs ===================================== @@ -0,0 +1,4 @@ +module T16145_aux where + +g :: IO () +g = return () ===================================== testsuite/tests/runghc/all.T ===================================== @@ -4,6 +4,8 @@ test('T8601', req_interp, makefile_test, []) test('T11247', [req_interp, expect_broken(11247)], makefile_test, []) +test('T16145', req_interp, makefile_test, []) + test('T6132', [], compile, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/5c57fa5f1a3fbba72a653dc8ecf2c3d... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/5c57fa5f1a3fbba72a653dc8ecf2c3d... You're receiving this email because of your account on gitlab.haskell.org.