Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC

Commits:

30 changed files:

Changes:

  • .gitlab/issue_templates/default.md
    ... ... @@ -20,5 +20,5 @@ Optional:
    20 20 
     * System Architecture:
    21 21
    22 22
    23 
    -/label ~bug
    23 
    +/label ~"T::bug"
    24 24 
     /label ~"needs triage"

  • compiler/GHC/ByteCode/Serialize.hs
    ... ... @@ -25,22 +25,26 @@ where
    25 25 
     import GHC.Prelude
    26 26
    27 27 
     import GHC.ByteCode.Binary
    28 
    -import GHC.ByteCode.Types
    29 28 
     import GHC.ByteCode.Recomp.Binary (computeFingerprint)
    30 
    -import GHC.Driver.Env
    29 
    +import GHC.ByteCode.Types
    31 30 
     import GHC.Driver.DynFlags
    31 
    +import GHC.Driver.Env
    32 32 
     import GHC.Iface.Binary
    33 33 
     import GHC.Iface.Recomp.Binary (putNameLiterally)
    34 34 
     import GHC.Linker.Types
    35 
    +import GHC.Settings.Constants (hiVersion)
    35 36 
     import GHC.Unit.Types
    36 37 
     import GHC.Utils.Binary
    37 
    -import GHC.Utils.TmpFs
    38 
    -import GHC.Utils.Logger
    39 38 
     import GHC.Utils.Fingerprint (Fingerprint)
    39 
    +import GHC.Utils.Logger
    40 
    +import GHC.Utils.Panic
    41 
    +import GHC.Utils.TmpFs
    40 42
    41 43 
     import Data.ByteString (ByteString)
    42 
    -import qualified Data.ByteString as BS
    44 
    +import Data.ByteString qualified as BS
    45 
    +import Data.Char (ord)
    43 46 
     import Data.Traversable
    47 
    +import Data.Word
    44 48 
     import System.Directory
    45 49 
     import System.FilePath
    46 50
    ... ... @@ -79,21 +83,35 @@ The ticket where bytecode objects were dicussed is #26298
    79 83
    80 84 
     See Note [-fwrite-byte-code is not the default]
    81 85 
     See Note [Recompilation avoidance with bytecode objects]
    86 
    +See Note [Persistent bytecode file headers]
    82 87
    88 
    +Note [Persistent bytecode file headers]
    89 
    +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    90 
    +Persistent bytecode files (`.gbc`) and bytecode libraries (`.bytecodelib`)
    91 
    +are version-specific binary formats. Without a small file-level header, stale
    92 
    +or corrupt files are only discovered once we start deserialising the payload,
    93 
    +which can lead to confusing failures.
    94 
    +
    95 
    +To make these failures explicit, we write a file-kind-specific magic word and
    96 
    +the current `hiVersion` ahead of the binary payload. Readers validate this
    97 
    +header before setting up the normal `Name`/`FastString` deserialisation
    98 
    +machinery. This follows the same approach as normal interface files.
    83 99 
     -}
    84 100
    85 101 
     writeBytecodeLib :: BytecodeLib -> FilePath -> IO ()
    86 102 
     writeBytecodeLib lib path = do
    87 103 
       odbco <- encodeBytecodeLib lib
    88 104 
       createDirectoryIfMissing True (takeDirectory path)
    89 
    -  bh' <- openBinMem (1024 * 1024)
    105 
    +  bh' <- openBinMem initBinMemSize
    90 106 
       bh <- addBinNameWriter bh'
    107 
    +  writePersistentBytecodeHeader BytecodeLibraryFile bh
    91 108 
       putWithUserData QuietBinIFace NormalCompression bh odbco
    92 109 
       writeBinMem bh path
    93 110
    94 111 
     readBytecodeLib :: HscEnv -> FilePath -> IO OnDiskBytecodeLib
    95 112 
     readBytecodeLib hsc_env path = do
    96 113 
       bh' <- readBinMem path
    114 
    +  readPersistentBytecodeHeader BytecodeLibraryFile path bh'
    97 115 
       bh <- addBinNameReader (hsc_NC hsc_env) bh'
    98 116 
       res <- getWithUserData (hsc_NC hsc_env) bh
    99 117 
       pure res
    ... ... @@ -185,6 +203,7 @@ readBinByteCode hsc_env f = do
    185 203 
     readOnDiskModuleByteCode :: HscEnv -> FilePath -> IO OnDiskModuleByteCode
    186 204 
     readOnDiskModuleByteCode hsc_env f = do
    187 205 
       bh' <- readBinMem f
    206 
    +  readPersistentBytecodeHeader ModuleByteCodeFile f bh'
    188 207 
       bh <- addBinNameReader (hsc_NC hsc_env) bh'
    189 208 
       getWithUserData (hsc_NC hsc_env) bh
    190 209
    ... ... @@ -192,9 +211,10 @@ readOnDiskModuleByteCode hsc_env f = do
    192 211 
     writeBinByteCode :: FilePath -> ModuleByteCode -> IO ()
    193 212 
     writeBinByteCode f cbc = do
    194 213 
       createDirectoryIfMissing True (takeDirectory f)
    195 
    -  bh' <- openBinMem (1024 * 1024)
    214 
    +  bh' <- openBinMem initBinMemSize
    196 215 
       bh <- addBinNameWriter bh'
    197 216 
       odbco <- encodeOnDiskModuleByteCode cbc
    217 
    +  writePersistentBytecodeHeader ModuleByteCodeFile bh
    198 218 
       putWithUserData QuietBinIFace NormalCompression bh odbco
    199 219 
       writeBinMem bh f
    200 220
    ... ... @@ -213,3 +233,64 @@ fingerprintModuleByteCodeContents :: Module -> CompiledByteCode -> [FilePath] ->
    213 233 
     fingerprintModuleByteCodeContents modl cbc foreign_files = do
    214 234 
       foreign_contents <- readObjectFiles foreign_files
    215 235 
       pure $ computeFingerprint putNameLiterally (modl, cbc, foreign_contents)
    236 
    +
    237 
    +-- ----------------------------------------------------------------------------
    238 
    +-- ByteCode module and library magic header.
    239 
    +-- ----------------------------------------------------------------------------
    240 
    +
    241 
    +data PersistentBytecodeFile
    242 
    +  = ModuleByteCodeFile
    243 
    +  | BytecodeLibraryFile
    244 
    +
    245 
    +-- See Note [Persistent bytecode file headers]
    246 
    +writePersistentBytecodeHeader :: PersistentBytecodeFile -> WriteBinHandle -> IO ()
    247 
    +writePersistentBytecodeHeader file_kind bh = do
    248 
    +  put_ bh (persistentBytecodeMagic file_kind)
    249 
    +  put_ bh (show hiVersion)
    250 
    +
    251 
    +readPersistentBytecodeHeader :: PersistentBytecodeFile -> FilePath -> ReadBinHandle -> IO ()
    252 
    +readPersistentBytecodeHeader file_kind path bh = do
    253 
    +  let mismatch what expected actual =
    254 
    +        throwGhcExceptionIO $ ProgramError $
    255 
    +          persistentBytecodeFileDescription file_kind ++ " header mismatch in " ++ path ++
    256 
    +          ": " ++ what ++ " (expected " ++ expected ++ ", got " ++ actual ++ ")"
    257 
    +
    258 
    +  magic <- get bh
    259 
    +  let expected_magic = persistentBytecodeMagic file_kind
    260 
    +  if unFixedLength magic == unFixedLength expected_magic
    261 
    +    then pure ()
    262 
    +    else mismatch "magic" (show $ unFixedLength expected_magic) (show $ unFixedLength magic)
    263 
    +
    264 
    +  version <- get bh
    265 
    +  let expected_version = show hiVersion
    266 
    +  if version == expected_version
    267 
    +    then pure ()
    268 
    +    else mismatch "version" expected_version version
    269 
    +
    270 
    +persistentBytecodeFileDescription :: PersistentBytecodeFile -> String
    271 
    +persistentBytecodeFileDescription ModuleByteCodeFile = "bytecode file"
    272 
    +persistentBytecodeFileDescription BytecodeLibraryFile = "bytecode library"
    273 
    +
    274 
    +persistentBytecodeMagic :: PersistentBytecodeFile -> FixedLengthEncoding Word32
    275 
    +persistentBytecodeMagic file_kind =
    276 
    +  case file_kind of
    277 
    +    ModuleByteCodeFile -> asciiWord32 "gbc0"
    278 
    +    BytecodeLibraryFile -> asciiWord32 "bcl0"
    279 
    +
    280 
    +-- | Encode a 4-letter word into a single Word32.
    281 
    +asciiWord32 :: String -> FixedLengthEncoding Word32
    282 
    +asciiWord32 [a, b, c, d] =
    283 
    +  FixedLengthEncoding $
    284 
    +    (fromIntegral (ord a) `shiftL` 24) .|.
    285 
    +    (fromIntegral (ord b) `shiftL` 16) .|.
    286 
    +    (fromIntegral (ord c) `shiftL` 8)  .|.
    287 
    +    fromIntegral (ord d)
    288 
    +asciiWord32 _ = error "asciiWord32: expected exactly four ASCII characters"
    289 
    +
    290 
    +-- ----------------------------------------------------------------------------
    291 
    +-- Constants and utils
    292 
    +-- ----------------------------------------------------------------------------
    293 
    +
    294 
    +-- | Initial ram buffer to allocate for writing .gbc and .bytecodelib files.
    295 
    +initBinMemSize :: Int
    296 
    +initBinMemSize = 1024 * 1024 -- 1 MB

  • compiler/GHC/Driver/Phases.hs
    ... ... @@ -262,7 +262,7 @@ objish_suffixes :: Platform -> [String]
    262 262 
     -- the GHC-compiled code will run
    263 263 
     objish_suffixes platform = case platformOS platform of
    264 264 
       OSMinGW32 -> [ "o", "O", "obj", "OBJ" ]
    265 
    -  _         -> [ "o" ]
    265 
    +  _         -> [ "o", "dyn_o"]
    266 266
    267 267 
     dynlib_suffixes :: Platform -> [String]
    268 268 
     dynlib_suffixes platform = case platformOS platform of

  • compiler/GHC/StgToCmm/Heap.hs
    1 
    +{-# LANGUAGE OverloadedStrings #-}
    1 2 
     -----------------------------------------------------------------------------
    2 3 
     --
    3 4 
     -- Stg to C--: heap management functions
    ... ... @@ -44,7 +45,7 @@ import GHC.Types.Id ( Id )
    44 45 
     import GHC.Unit
    45 46 
     import GHC.Platform
    46 47 
     import GHC.Platform.Profile
    47 
    -import GHC.Data.FastString( mkFastString, fsLit )
    48 
    +import GHC.Data.FastString( FastString )
    48 49 
     import GHC.Utils.Panic( sorry )
    49 50
    50 51 
     import Control.Monad (when)
    ... ... @@ -125,7 +126,7 @@ allocHeapClosure rep info_ptr use_cc payload = do
    125 126 
                 -- ie 1 *before* the info-ptr word of new object.
    126 127
    127 128 
       base <- getHpRelOffset info_offset
    128 
    -  emitComment $ mkFastString "allocHeapClosure"
    129 
    +  emitComment "allocHeapClosure"
    129 130 
       emitSetDynHdr base info_ptr use_cc
    130 131
    131 132 
       -- Fill in the fields
    ... ... @@ -460,35 +461,41 @@ genericGC checkYield code
    460 461 
            call <- mkCall generic_gc (GC, GC) [] [] updfr_sz []
    461 462 
            heapCheck False checkYield (call <*> mkBranch lretry) code
    462 463
    464 
    +-- | Predefined ("canned") GC functions
    465 
    +--
    466 
    +-- Functions have been added to cover 99% of the GC calls made in GHC and Cabal.
    467 
    +-- See #27142.
    463 468 
     cannedGCEntryPoint :: Platform -> [LocalReg] -> Maybe CmmExpr
    464 
    -cannedGCEntryPoint platform regs
    465 
    -  = case map localRegType regs of
    466 
    -      []  -> Just (mkGcLabel "stg_gc_noregs")
    467 
    -      [ty]
    468 
    -          | isGcPtrType ty -> Just (mkGcLabel "stg_gc_unpt_r1")
    469 
    -          | isFloatType ty -> case width of
    470 
    -                                  W32       -> Just (mkGcLabel "stg_gc_f1")
    471 
    -                                  W64       -> Just (mkGcLabel "stg_gc_d1")
    472 
    -                                  _         -> Nothing
    473 
    -
    474 
    -          | width == wordWidth platform -> Just (mkGcLabel "stg_gc_unbx_r1")
    475 
    -          | width == W64                -> Just (mkGcLabel "stg_gc_l1")
    476 
    -          | otherwise                   -> Nothing
    477 
    -          where
    478 
    -              width = typeWidth ty
    479 
    -      [ty1,ty2]
    480 
    -          |  isGcPtrType ty1
    481 
    -          && isGcPtrType ty2 -> Just (mkGcLabel "stg_gc_pp")
    482 
    -      [ty1,ty2,ty3]
    483 
    -          |  isGcPtrType ty1
    484 
    -          && isGcPtrType ty2
    485 
    -          && isGcPtrType ty3 -> Just (mkGcLabel "stg_gc_ppp")
    486 
    -      [ty1,ty2,ty3,ty4]
    487 
    -          |  isGcPtrType ty1
    488 
    -          && isGcPtrType ty2
    489 
    -          && isGcPtrType ty3
    490 
    -          && isGcPtrType ty4 -> Just (mkGcLabel "stg_gc_pppp")
    491 
    -      _otherwise -> Nothing
    469 
    +cannedGCEntryPoint platform regs =
    470 
    +  case map localRegType regs of
    471 
    +    []   -> ret "stg_gc_noregs"
    472 
    +    [ty]
    473 
    +        | is_gc  ty -> ret "stg_gc_unpt_r1"
    474 
    +        | is_f32 ty -> ret "stg_gc_f1"
    475 
    +        | is_f64 ty -> ret "stg_gc_d1"
    476 
    +        | is_wn ty  -> ret "stg_gc_unbx_r1"
    477 
    +        | is_w64 ty -> ret "stg_gc_l1"
    478 
    +    [ty1,ty2]
    479 
    +        | is_gc ty1 && is_gc ty2 -> ret "stg_gc_pp"
    480 
    +        | is_gc ty1 && is_wn ty2 -> ret "stg_gc_pi"
    481 
    +        | is_wn ty1 && is_gc ty2 -> ret "stg_gc_ip"
    482 
    +        | is_wn ty1 && is_wn ty2 -> ret "stg_gc_ii"
    483 
    +    [ty1,ty2,ty3]
    484 
    +        | is_gc ty1 && is_gc ty2 && is_gc ty3 -> ret "stg_gc_ppp"
    485 
    +        | is_w8 ty1 && is_gc ty2 && is_gc ty3 -> ret "stg_gc_bpp"
    486 
    +    [ty1,ty2,ty3,ty4]
    487 
    +        | is_gc ty1 && is_gc ty2 && is_gc ty3 && is_gc ty4 -> ret "stg_gc_pppp"
    488 
    +    [ty1,ty2,ty3,ty4,ty5]
    489 
    +        | is_gc ty1 && is_gc ty2 && is_gc ty3 && is_gc ty4 && is_gc ty5 -> ret "stg_gc_ppppp"
    490 
    +    _ -> Nothing
    491 
    +  where
    492 
    +    ret fs = Just (mkGcLabel fs)
    493 
    +    is_gc  ty = isGcPtrType ty
    494 
    +    is_wn  ty = isBitsType ty && typeWidth ty == wordWidth platform
    495 
    +    is_w8  ty = isBitsType ty && typeWidth ty == W8
    496 
    +    is_w64 ty = isBitsType ty && typeWidth ty == W64
    497 
    +    is_f32 ty = isFloatType ty && typeWidth ty == W32
    498 
    +    is_f64 ty = isFloatType ty && typeWidth ty == W64
    492 499
    493 500 
     -- Note [stg_gc arguments]
    494 501 
     -- ~~~~~~~~~~~~~~~~~~~~~~~
    ... ... @@ -514,8 +521,8 @@ generic_gc :: CmmExpr
    514 521 
     generic_gc = mkGcLabel "stg_gc_noregs"
    515 522
    516 523 
     -- | Create a CLabel for calling a garbage collector entry point
    517 
    -mkGcLabel :: String -> CmmExpr
    518 
    -mkGcLabel s = CmmLit (CmmLabel (mkCmmCodeLabel rtsUnitId (fsLit s)))
    524 
    +mkGcLabel :: FastString -> CmmExpr
    525 
    +mkGcLabel s = CmmLit (CmmLabel (mkCmmCodeLabel rtsUnitId s))
    519 526
    520 527 
     -------------------------------
    521 528 
     heapCheck :: Bool -> Bool -> CmmAGraph -> FCode a -> FCode a

  • rts/HeapStackCheck.cmm
    ... ... @@ -373,8 +373,6 @@ stg_gc_l1 return (L_ l)
    373 373 
         jump stg_gc_noregs (stg_ret_l_info, l) ();
    374 374 
     }
    375 375
    376 
    -/*-- Unboxed tuples with multiple pointers -------------------------------- */
    377 
    -
    378 376 
     stg_gc_pp return (P_ arg1, P_ arg2)
    379 377 
     {
    380 378 
         call stg_gc_noregs();
    ... ... @@ -393,6 +391,36 @@ stg_gc_pppp return (P_ arg1, P_ arg2, P_ arg3, P_ arg4)
    393 391 
         return (arg1,arg2,arg3,arg4);
    394 392 
     }
    395 393
    394 
    +stg_gc_ppppp return (P_ arg1, P_ arg2, P_ arg3, P_ arg4, P_ arg5)
    395 
    +{
    396 
    +    call stg_gc_noregs();
    397 
    +    return (arg1,arg2,arg3,arg4,arg5);
    398 
    +}
    399 
    +
    400 
    +stg_gc_ip return (W_ arg1, P_ arg2)
    401 
    +{
    402 
    +    call stg_gc_noregs();
    403 
    +    return (arg1,arg2);
    404 
    +}
    405 
    +
    406 
    +stg_gc_pi return (P_ arg1, W_ arg2)
    407 
    +{
    408 
    +    call stg_gc_noregs();
    409 
    +    return (arg1,arg2);
    410 
    +}
    411 
    +
    412 
    +stg_gc_ii return (W_ arg1, W_ arg2)
    413 
    +{
    414 
    +    call stg_gc_noregs();
    415 
    +    return (arg1,arg2);
    416 
    +}
    417 
    +
    418 
    +stg_gc_bpp return (I8 arg1, P_ arg2, P_ arg3)
    419 
    +{
    420 
    +    call stg_gc_noregs();
    421 
    +    return (arg1,arg2,arg3);
    422 
    +}
    423 
    +
    396 424 
     /* -----------------------------------------------------------------------------
    397 425 
        Generic function entry heap check code.
    398 426

  • rts/RtsSymbols.c
    ... ... @@ -499,6 +499,11 @@ extern char **environ;
    499 499 
           SymI_HasDataProto(stg_gc_pp)                                          \
    500 500 
           SymI_HasDataProto(stg_gc_ppp)                                         \
    501 501 
           SymI_HasDataProto(stg_gc_pppp)                                        \
    502 
    +      SymI_HasDataProto(stg_gc_ppppp)                                       \
    503 
    +      SymI_HasDataProto(stg_gc_ip)                                          \
    504 
    +      SymI_HasDataProto(stg_gc_pi)                                          \
    505 
    +      SymI_HasDataProto(stg_gc_ii)                                          \
    506 
    +      SymI_HasDataProto(stg_gc_bpp)                                         \
    502 507 
           SymI_HasDataProto(__stg_gc_fun)                                       \
    503 508 
           SymI_HasDataProto(stg_gc_fun_info)                                    \
    504 509 
           SymI_HasDataProto(stg_yield_noregs)                                   \

  • rts/include/stg/MiscClosures.h
    ... ... @@ -361,6 +361,11 @@ RTS_FUN_DECL(stg_gc_l1);
    361 361 
     RTS_FUN_DECL(stg_gc_pp);
    362 362 
     RTS_FUN_DECL(stg_gc_ppp);
    363 363 
     RTS_FUN_DECL(stg_gc_pppp);
    364 
    +RTS_FUN_DECL(stg_gc_ppppp);
    365 
    +RTS_FUN_DECL(stg_gc_ip);
    366 
    +RTS_FUN_DECL(stg_gc_pi);
    367 
    +RTS_FUN_DECL(stg_gc_ii);
    368 
    +RTS_FUN_DECL(stg_gc_bpp);
    364 369
    365 370 
     RTS_RET(stg_gc_fun);
    366 371 
     RTS_FUN_DECL(__stg_gc_fun);

  • rts/posix/FdWakeup.c
    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 
    +}

  • rts/posix/FdWakeup.h
    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 
    +

  • rts/posix/Ticker.c
    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 
    +}

  • rts/posix/ticker/Pthread.c deleted
    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 
    -}

  • rts/posix/ticker/TimerFd.c deleted
    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 
    -}

  • rts/rts.cabal
    ... ... @@ -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

  • testsuite/driver/testlib.py
    ... ... @@ -3043,6 +3043,12 @@ def normalise_errmsg(s: str) -> str:
    3043 3043 
         # Old emcc warns when we export HEAP8 but new one requires it (see #26290)
    3044 3044 
         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','')
    3045 3045
    3046 
    +    # on newer versions of MacOS X, the shipped ranlib warns about object files with no symbols,
    3047 
    +    # however, these are completely benign stubs.
    3048 
    +    # See https://gitlab.haskell.org/ghc/ghc/-/issues/27116
    3049 
    +    if opsys('darwin'):
    3050 
    +        s = modify_lines(s, lambda l: re.sub(r'.*ranlib:.*has no symbols', '', l))
    3051 
    +
    3046 3052 
         return s
    3047 3053
    3048 3054 
     # 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':
    120 120 
     else:
    121 121 
       only_darwin = skip
    122 122
    123 
    -test('static001', [extra_files(['Static001.hs']),
    124 
    -                   only_darwin,
    125 
    -                   when(arch('x86_64'), expect_broken(8127))],
    123 
    +test('static001', [extra_files(['Static001.hs']), only_darwin],
    126 124 
          makefile_test, ['static001'])
    127 125
    128 126 
     test('dynHelloWorld',

  • testsuite/tests/driver/bytecode-object/Makefile
    ... ... @@ -159,3 +159,9 @@ bytecode_object25:
    159 159 
     	"$(TEST_HC)" $(TEST_HC_OPTS) -c BytecodeForeign.hs -fbyte-code -fwrite-byte-code -fwrite-interface $(ghciWayFlags)
    160 160 
     	"$(TEST_HC)" $(TEST_HC_OPTS_INTERACTIVE) -v1 -fno-hide-source-paths  -fbyte-code -fwrite-byte-code -fwrite-interface BytecodeForeign.hs -e "testForeign"
    161 161
    162 
    +# Test that corrupt bytecode file headers are rejected clearly.
    163 
    +bytecode_object26:
    164 
    +	"$(TEST_HC)" $(TEST_HC_OPTS) -c BytecodeTest.hs -fbyte-code -fwrite-byte-code
    165 
    +	@printf 'bad!' | dd of=BytecodeTest.gbc bs=1 count=4 conv=notrunc 2>/dev/null
    166 
    +	! "$(TEST_HC)" $(TEST_HC_OPTS) -c -bytecodelib -o linked.bytecode BytecodeTest.gbc 2> bytecode_object26.stderr
    167 
    +	@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'])
    26 26 
     test('bytecode_object23', bytecode_opts, makefile_test, ['bytecode_object23'])
    27 27 
     test('bytecode_object24', bytecode_opts + [copy_files], makefile_test, ['bytecode_object24'])
    28 28 
     test('bytecode_object25', [bytecode_opts, req_interp, extra_files(['BytecodeForeign.hs', 'BytecodeForeign.c'])], makefile_test, ['bytecode_object25'])
    29 
    +test('bytecode_object26', [bytecode_opts], makefile_test, ['bytecode_object26'])

  • testsuite/tests/plugins/Makefile
    ... ... @@ -238,3 +238,10 @@ test-late-plugin:
    238 238 
     .PHONY: T21730
    239 239 
     T21730:
    240 240 
     	"$(TEST_HC)" $(TEST_HC_OPTS) $(ghcPluginWayFlags) -v0 T21730.hs -package-db T21730-plugin/pkg.T21730-plugin/local.package.conf
    241 
    +
    242 
    +# Test that .dyn_o files are accepted as valid object files on the command line
    243 
    +# without producing "ignoring unrecognised input" warnings (#24486)
    244 
    +.PHONY: T24486
    245 
    +T24486:
    246 
    +	"$(TEST_HC)" $(TEST_HC_OPTS) -v0 -c T24486_Helper.hs -osuf dyn_o
    247 
    +	"$(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
    1 
    +TOP=../../..
    2 
    +include $(TOP)/mk/boilerplate.mk
    3 
    +include $(TOP)/mk/test.mk
    4 
    +
    5 
    +clean.%:
    6 
    +	rm -rf pkg.$*
    7 
    +
    8 
    +HERE := $(abspath .)
    9 
    +$(eval $(call canonicalise,HERE))
    10 
    +
    11 
    +package.%:
    12 
    +	$(MAKE) -s --no-print-directory clean.$*
    13 
    +	mkdir pkg.$*
    14 
    +	"$(TEST_HC)" -outputdir pkg.$* --make -v0 -o pkg.$*/setup Setup.hs
    15 
    +	"$(GHC_PKG)" init pkg.$*/local.package.conf
    16 
    +	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)
    17 
    +	pkg.$*/setup build     --distdir pkg.$*/dist -v0
    18 
    +	pkg.$*/setup install   --distdir pkg.$*/dist -v0

  • testsuite/tests/plugins/T24486-plugin/Setup.hs
    1 
    +import Distribution.Simple
    2 
    +main = defaultMain

  • testsuite/tests/plugins/T24486-plugin/T24486-plugin.cabal
    1 
    +Name:           T24486-plugin
    2 
    +Version:        0.1
    3 
    +Synopsis:       For testing
    4 
    +Cabal-Version:  >= 1.2
    5 
    +Build-Type:     Simple
    6 
    +
    7 
    +Library
    8 
    +    Build-Depends: base, ghc
    9 
    +    Exposed-Modules: T24486_Plugin

  • testsuite/tests/plugins/T24486-plugin/T24486_Plugin.hs
    1 
    +module T24486_Plugin (plugin) where
    2 
    +
    3 
    +import GHC.Plugins
    4 
    +
    5 
    +plugin :: Plugin
    6 
    +plugin = defaultPlugin

  • testsuite/tests/plugins/T24486.hs
    1 
    +module Main where
    2 
    +
    3 
    +main :: IO ()
    4 
    +main = return ()

  • testsuite/tests/plugins/T24486_Helper.hs
    1 
    +module T24486_Helper where
    2 
    +
    3 
    +helper :: Int
    4 
    +helper = 42

  • testsuite/tests/plugins/all.T
    ... ... @@ -395,3 +395,10 @@ test('T21730',
    395 395 
           pre_cmd('$MAKE -s --no-print-directory -C T21730-plugin package.T21730-plugin TOP={top}')
    396 396 
           ],
    397 397 
          makefile_test, [])
    398 
    +
    399 
    +test('T24486',
    400 
    +     [extra_files(['T24486-plugin/', 'T24486_Helper.hs']),
    401 
    +      when(opsys('mingw32'), skip),
    402 
    +      pre_cmd('$MAKE -s --no-print-directory -C T24486-plugin package.T24486-plugin TOP={top}')
    403 
    +      ],
    404 
    +     makefile_test, [])

  • testsuite/tests/runghc/Makefile
    ... ... @@ -23,6 +23,11 @@ T11247:
    23 23 
     	-'$(RUNGHC)' foo.
    24 24 
     	-'$(RUNGHC)' foo.bar
    25 25
    26 
    +# runghc should honour -osuf for dependencies too (#16145).
    27 
    +T16145:
    28 
    +	'$(RUNGHC)' -- -fobject-code -osuf=hs.o T16145
    29 
    +	printf '%s\n' *.hi *.o *.hs | LC_ALL=C sort
    30 
    +
    26 31 
     T17171a:
    27 32 
     	'$(RUNGHC)' --ghc-arg=-Wall T17171a.hs
    28 33 
     T17171b:

  • testsuite/tests/runghc/T16145.hs
    1 
    +module T16145 where
    2 
    +
    3 
    +import T16145_aux
    4 
    +
    5 
    +main = g

  • testsuite/tests/runghc/T16145.stdout
    1 
    +T16145.hi
    2 
    +T16145.hs
    3 
    +T16145.hs.o
    4 
    +T16145_aux.hi
    5 
    +T16145_aux.hs
    6 
    +T16145_aux.hs.o

  • testsuite/tests/runghc/T16145_aux.hs
    1 
    +module T16145_aux where
    2 
    +
    3 
    +g :: IO ()
    4 
    +g = return ()

  • testsuite/tests/runghc/all.T
    ... ... @@ -4,6 +4,8 @@ test('T8601', req_interp, makefile_test, [])
    4 4
    5 5 
     test('T11247', [req_interp, expect_broken(11247)], makefile_test, [])
    6 6
    7 
    +test('T16145', req_interp, makefile_test, [])
    8 
    +
    7 9 
     test('T6132', [],
    8 10 
          compile, [''])
    9 11

    • —
    View it on GitLab.
    You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications · Help