Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 05586983 by Peng Fan at 2026-04-01T05:14:50-04:00 NCG/LA64: add cmpxchg and xchg primops And append some new instructions for LA664 uarch. Apply fix to cmpxchg-prim by Andreas Klebinger. Suggestions in https://gitlab.haskell.org/ghc/ghc/-/merge_requests/15515 - - - - - 501f6520 by Duncan Coutts at 2026-04-01T05:14:51-04:00 Remove signal-based ticker implementations Fixes issue #27073 All supported platforms should work with the pthreads + nanosleep based ticker implementation. This avoids all the problems with using signals. In practice, all supported platforms were probably using the non-signal tickers already, which is probably why we do not get lots of reports about deadlocks and other weirdness: we were definately using functions that are not async signal safe in the tick handler (such as fflush to flussh the eventlog). Only Solaris was explicitly using the timer_create ticker impl, and even Solaris could probably use the pthreads one (if anyone cared: Solaris is no longer a Teir 3 supported platform). Plausibly the only supported platform that this will change will be AIX, which should now use the pthreads impl. - - - - - efee2a42 by Duncan Coutts at 2026-04-01T05:14:51-04:00 Tidy up some timer/ticker comments elsewhere - - - - - 7a5dbd06 by Duncan Coutts at 2026-04-01T05:14:51-04:00 Remove now-unused install_vtalrm_handler Support function used by both of the signal-based ticker implementations. - - - - - 8557b4e4 by Duncan Coutts at 2026-04-01T05:14:51-04:00 No longer probe for timer_create in rts/configure It was only used by the TimerCreate.c ticker impl. - - - - - 4cbcb41d by Duncan Coutts at 2026-04-01T05:14:51-04:00 Note that rtsTimerSignal is deprecated. - - - - - e8547953 by Simon Jakobi at 2026-04-01T05:14:52-04:00 Add perf test for #13960 Closes #13960. - - - - - 15 changed files: - compiler/GHC/CmmToAsm/LA64/CodeGen.hs - compiler/GHC/CmmToAsm/LA64/Instr.hs - compiler/GHC/CmmToAsm/LA64/Ppr.hs - − m4/fp_check_timer_create.m4 - rts/Timer.c - rts/configure.ac - rts/include/rts/Timer.h - rts/include/stg/SMP.h - rts/posix/Signals.c - rts/posix/Signals.h - rts/posix/Ticker.c - − rts/posix/ticker/Setitimer.c - − rts/posix/ticker/TimerCreate.c - + testsuite/tests/perf/compiler/T13960.hs - testsuite/tests/perf/compiler/all.T Changes: ===================================== compiler/GHC/CmmToAsm/LA64/CodeGen.hs ===================================== @@ -57,6 +57,12 @@ import Control.Monad import GHC.Cmm.Dataflow.Label import GHC.Types.Unique.DSM import GHC.Types.Literal.Floating +import GHC.Unit.Types ( ghcInternalUnitId ) + +la664Enabled :: NatM Bool +la664Enabled = do + config <- getConfig + return (ncgLa664Enabled config) -- [General layout of an NCG] cmmTopCodeGen :: @@ -1651,6 +1657,10 @@ genPrim (MO_Prefetch_Data _n) [] [_] = return nilOL genPrim (MO_AtomicRead w mo) [dst] [addr] = genAtomicRead w mo dst addr genPrim (MO_AtomicWrite w mo) [] [addr,val] = genAtomicWrite w mo addr val +genPrim (MO_AtomicRMW width amop) [dst] [addr,n] = genLibCCall (atomicRMWLabel width amop) [dst] [addr,n] +genPrim (MO_Cmpxchg width) [dst] [addr,expe,new] = genCmpxchg width dst addr expe new +genPrim (MO_Xchg width) [dst] [addr,value] = genXchg width dst addr value + genPrim mop@(MO_S_Mul2 _w) _ _ = unsupported mop genPrim mop@(MO_S_QuotRem _w) _ _ = unsupported mop genPrim mop@(MO_U_QuotRem _w) _ _ = unsupported mop @@ -1674,9 +1684,6 @@ genPrim (MO_PopCnt width) [dst] [src] = genLibCCall (popCntLabel w genPrim (MO_Pdep width) [dst] [src,mask] = genLibCCall (pdepLabel width) [dst] [src,mask] genPrim (MO_Pext width) [dst] [src,mask] = genLibCCall (pextLabel width) [dst] [src,mask] genPrim (MO_UF_Conv width) [dst] [src] = genLibCCall (word2FloatLabel width) [dst] [src] -genPrim (MO_AtomicRMW width amop) [dst] [addr,n] = genLibCCall (atomicRMWLabel width amop) [dst] [addr,n] -genPrim (MO_Cmpxchg width) [dst] [addr,old,new] = genLibCCall (cmpxchgLabel width) [dst] [addr,old,new] -genPrim (MO_Xchg width) [dst] [addr,val] = genLibCCall (xchgLabel width) [dst] [addr,val] genPrim (MO_Memcpy _align) [] [dst,src,n] = genLibCCall (fsLit "memcpy") [] [dst,src,n] genPrim (MO_Memmove _align) [] [dst,src,n] = genLibCCall (fsLit "memmove") [] [dst,src,n] genPrim (MO_Memcmp _align) [rst] [dst,src,n] = genLibCCall (fsLit "memcmp") [rst] [dst,src,n] @@ -1872,6 +1879,20 @@ genBitRev w dst src = do ) _ -> return ( code_x `snocOL` BITREV (OpReg w dst_reg) (OpReg w reg_x)) +genPrimCCall + :: FastString + -> [CmmFormal] + -> [CmmActual] + -> NatM InstrBlock + +genPrimCCall name dsts args = do + config <- getConfig + target <- + cmmMakeDynamicReference config CallReference + $ mkCmmCodeLabel ghcInternalUnitId name + let cconv = ForeignConvention CCallConv [NoHint] [NoHint] CmmMayReturn + genCCall target cconv dsts args + -- Generate C call to the given function in libc genLibCCall :: FastString -> [CmmFormal] -> [CmmActual] -> NatM InstrBlock genLibCCall name dsts args = do @@ -1945,6 +1966,52 @@ genAtomicWrite w mo addr val = do ) _ -> panic $ "Unexpected MemOrderAcquire on an AtomicWrite" ++ show mo +genCmpxchg :: Width -> LocalReg -> CmmExpr -> CmmExpr -> CmmExpr -> NatM InstrBlock +genCmpxchg w dst addr expe new = do + config <- getConfig + let + platform = ncgPlatform config + format = intFormat w + + la664Enabled >>= \case + + True -> do + (addr_reg, _, code_addr) <- getSomeReg addr + (expe_reg, _, code_expe) <- getSomeReg expe + (new_reg, _, code_new) <- getSomeReg new + let dst_reg = getRegisterReg platform (CmmLocal dst) + return $ code_addr `appOL` code_expe `appOL` code_new `appOL` toOL + [ + -- Behave like the GCC builtin CAS operation + AMCASDB format (OpReg w expe_reg) (OpReg w new_reg) (OpReg w addr_reg), + MOV (OpReg w dst_reg) (OpReg w expe_reg) + ] + + False -> + genPrimCCall (cmpxchgLabel w) [dst] [addr,expe,new] + +genXchg :: Width -> LocalReg -> CmmExpr -> CmmExpr -> NatM InstrBlock +genXchg w dst addr val = do + config <- getConfig + tmp <- getNewRegNat II64 + let + platform = ncgPlatform config + format = intFormat w + + la664Enabled >>= \case + + True -> do + (addr_reg, _, code_addr) <- getSomeReg addr + (val_reg, _, code_val) <- getSomeReg val + let dst_reg = getRegisterReg platform (CmmLocal dst) + return $ code_addr `appOL` code_val `appOL` toOL + [ + AMSWAPDB format (OpReg w tmp) (OpReg w val_reg) (OpReg w addr_reg), + MOV (OpReg W64 dst_reg) (OpReg W64 tmp) + ] + False -> + genPrimCCall (xchgLabel w) [dst] [addr,val] + -- ----------------------------------------------------------------------------- {- Generating C calls @@ -1977,6 +2044,7 @@ member of a structure or union argument, or a vector/floating-point argument wider than FRLEN may be passed in a GAR. -} +-- Generate C call to the given function in ghc-prim genCCall :: CmmExpr -- address of func call -> ForeignConvention -- calling convention ===================================== compiler/GHC/CmmToAsm/LA64/Instr.hs ===================================== @@ -150,10 +150,11 @@ regUsageOfInstr platform instr = case instr of -- ranges, corresponding to 2 and 1 instruction implementations respectively. -- -- BCOND1 is selected by default. - BCOND1 _ j d t -> usage (regTarget t ++ regOp j ++ regOp d, []) - BCOND _ j d t -> usage (regTarget t ++ regOp j ++ regOp d, []) - BEQZ j t -> usage (regTarget t ++ regOp j, []) - BNEZ j t -> usage (regTarget t ++ regOp j, []) + BCOND1 _ j d t -> usage (regTarget t ++ regOp j ++ regOp d, []) + BCOND _ j d t -> usage (regTarget t ++ regOp j ++ regOp d, []) + BEQZ1 o1 o2 -> usage (regOp o1 ++ regOp o2, []) + BEQZ j t -> usage (regTarget t ++ regOp j, []) + BNEZ j t -> usage (regTarget t ++ regOp j, []) -- 5. Common Memory Access Instructions -------------------------------------- LD _ dst src -> usage (regOp src, regOp dst) LDU _ dst src -> usage (regOp src, regOp dst) @@ -168,7 +169,17 @@ regUsageOfInstr platform instr = case instr of -- LDCOND dst src1 src2 -> usage (regOp src1 ++ regOp src2, regOp dst) -- STCOND dst src1 src2 -> usage (regOp src1 ++ regOp src2, regOp dst) -- 7. Atomic Memory Access Instructions -------------------------------------- + -- In LoongArch, if the AM* atomic memory access instruction has the same register number as rd and rj, + -- the execution will trigger an Instruction Non-defined Exception. Here should be avoided. AMSWAPDB _ dst src1 src2 -> usage (regOp src1 ++ regOp src2, regOp dst) + AMADDDB _ dst src1 src2 -> usage (regOp src1 ++ regOp src2, regOp dst) + AMANDDB _ dst src1 src2 -> usage (regOp src1 ++ regOp src2, regOp dst) + AMORDB _ dst src1 src2 -> usage (regOp src1 ++ regOp src2, regOp dst) + AMXORDB _ dst src1 src2 -> usage (regOp src1 ++ regOp src2, regOp dst) + --AMCASDB _ dst src1 src2 -> usage (regOp src1 ++ regOp src2, regOp src1 ++ regOp src2 ++ regOp dst) + AMCASDB _ dst src1 src2 -> usage (regOp dst ++ regOp src1 ++ regOp src2, regOp dst) + LL _ dst src1 _ -> usage (regOp src1, regOp dst) + SC _ dst src1 _ -> usage (regOp src1, regOp dst) -- 8. Barrier Instructions --------------------------------------------------- DBAR _hint -> usage ([], []) IBAR _hint -> usage ([], []) @@ -330,6 +341,7 @@ patchRegsOfInstr instr env = case instr of TAIL36 r t -> TAIL36 (patchOp r) (patchTarget t) BCOND1 c j d t -> BCOND1 c (patchOp j) (patchOp d) (patchTarget t) BCOND c j d t -> BCOND c (patchOp j) (patchOp d) (patchTarget t) + BEQZ1 o1 o2 -> BEQZ1 (patchOp o1) (patchOp o2) BEQZ j t -> BEQZ (patchOp j) (patchTarget t) BNEZ j t -> BNEZ (patchOp j) (patchTarget t) -- 5. Common Memory Access Instructions -------------------------------------- @@ -348,6 +360,13 @@ patchRegsOfInstr instr env = case instr of -- STCOND o1 o2 o3 -> STCOND (patchOp o1) (patchOp o2) (patchOp o3) -- 7. Atomic Memory Access Instructions -------------------------------------- AMSWAPDB f o1 o2 o3 -> AMSWAPDB f (patchOp o1) (patchOp o2) (patchOp o3) + AMADDDB f o1 o2 o3 -> AMADDDB f (patchOp o1) (patchOp o2) (patchOp o3) + AMANDDB f o1 o2 o3 -> AMANDDB f (patchOp o1) (patchOp o2) (patchOp o3) + AMORDB f o1 o2 o3 -> AMORDB f (patchOp o1) (patchOp o2) (patchOp o3) + AMXORDB f o1 o2 o3 -> AMXORDB f (patchOp o1) (patchOp o2) (patchOp o3) + AMCASDB f o1 o2 o3 -> AMCASDB f (patchOp o1) (patchOp o2) (patchOp o3) + LL f o1 o2 o3 -> LL f (patchOp o1) (patchOp o2) (patchOp o3) + SC f o1 o2 o3 -> SC f (patchOp o1) (patchOp o2) (patchOp o3) -- 8. Barrier Instructions --------------------------------------------------- DBAR o1 -> DBAR o1 IBAR o1 -> IBAR o1 @@ -398,6 +417,7 @@ isJumpishInstr instr = case instr of TAIL36 {} -> True BCOND1 {} -> True BCOND {} -> True + BEQZ1 {} -> True BEQZ {} -> True BNEZ {} -> True _ -> False @@ -718,6 +738,7 @@ data Instr | TAIL36 Operand Target | BCOND1 Cond Operand Operand Target | BCOND Cond Operand Operand Target + | BEQZ1 Operand Operand | BEQZ Operand Target | BNEZ Operand Target -- 5. Common Memory Access Instructions -------------------------------------- @@ -733,6 +754,13 @@ data Instr -- 6. Bound Check Memory Access Instructions --------------------------------- -- 7. Atomic Memory Access Instructions -------------------------------------- | AMSWAPDB Format Operand Operand Operand + | AMADDDB Format Operand Operand Operand + | AMANDDB Format Operand Operand Operand + | AMORDB Format Operand Operand Operand + | AMXORDB Format Operand Operand Operand + | AMCASDB Format Operand Operand Operand + | LL Format Operand Operand Operand + | SC Format Operand Operand Operand -- 8. Barrier Instructions --------------------------------------------------- | DBAR BarrierType | IBAR BarrierType @@ -839,6 +867,7 @@ instrCon i = TAIL36{} -> "TAIL36" BCOND1{} -> "BCOND1" BCOND{} -> "BCOND" + BEQZ1{} -> "BEQZ1" BEQZ{} -> "BEQZ" BNEZ{} -> "BNEZ" LD{} -> "LD" @@ -851,6 +880,13 @@ instrCon i = STPTR{} -> "STPTR" PRELD{} -> "PRELD" AMSWAPDB{} -> "AMSWAPDB" + AMADDDB{} -> "AMADDDB" + AMANDDB{} -> "AMANDDB" + AMORDB{} -> "AMORDB" + AMXORDB{} -> "AMXORDB" + AMCASDB{} -> "AMCASDB" + LL{} -> "LL" + SC{} -> "SC" DBAR{} -> "DBAR" IBAR{} -> "IBAR" FCVT{} -> "FCVT" ===================================== compiler/GHC/CmmToAsm/LA64/Ppr.hs ===================================== @@ -852,6 +852,7 @@ pprInstr platform instr = case instr of line $ text "\tbgeu" <+> pprOp platform d <> comma <+> pprOp platform j <> comma <+> pprAsmLabel platform (mkLocalBlockLabel (getUnique bid)) UGT -> line $ text "\tbltu" <+> pprOp platform d <> comma <+> pprOp platform j <> comma <+> pprAsmLabel platform (mkLocalBlockLabel (getUnique bid)) + _ -> line $ text "\t" <> pprBcond c <+> pprOp platform j <> comma <+> pprOp platform d <> comma <+> pprAsmLabel platform (mkLocalBlockLabel (getUnique bid)) BCOND1 _ _ _ (TLabel _) -> panic "LA64.ppr: BCOND1: No conditional branching to TLabel!" @@ -916,17 +917,18 @@ pprInstr platform instr = case instr of BCOND _ _ _ (TReg _) -> panic "LA64.ppr: BCOND: No conditional branching to registers!" + BEQZ1 o1 o2 | isImmOp o2 -> op2 (text "\tbeqz") o1 o2 BEQZ j (TBlock bid) -> line $ text "\tbeqz" <+> pprOp platform j <> comma <+> pprAsmLabel platform (mkLocalBlockLabel (getUnique bid)) BEQZ j (TLabel lbl) -> line $ text "\tbeqz" <+> pprOp platform j <> comma <+> pprAsmLabel platform lbl - BEQZ _ (TReg _) -> panic "LA64.ppr: BEQZ: No conditional branching to registers!" + BEQZ _ (TReg _) -> panic "LA64.ppr: BEQZ: No conditional branching to registers!" BNEZ j (TBlock bid) -> line $ text "\tbnez" <+> pprOp platform j <> comma <+> pprAsmLabel platform (mkLocalBlockLabel (getUnique bid)) BNEZ j (TLabel lbl) -> line $ text "\tbnez" <+> pprOp platform j <> comma <+> pprAsmLabel platform lbl - BNEZ _ (TReg _) -> panic "LA64.ppr: BNEZ: No conditional branching to registers!" + BNEZ _ (TReg _) -> panic "LA64.ppr: BNEZ: No conditional branching to registers!" -- 5. Common Memory Access Instructions -------------------------------------- -- LD.{B[U]/H[U]/W[U]/D}, ST.{B/H/W/D}: AddrRegImm @@ -1020,8 +1022,29 @@ pprInstr platform instr = case instr of AMSWAPDB II32 o1 o2 o3 -> op3 (text "\tamswap_db.w") o1 o2 o3 AMSWAPDB II64 o1 o2 o3 -> op3 (text "\tamswap_db.d") o1 o2 o3 -- AM.{SWAP/ADD}[_DB].{B/H} + AMADDDB II8 o1 o2 o3 -> op3 (text "\tamadd_db.b") o1 o2 o3 + AMADDDB II16 o1 o2 o3 -> op3 (text "\tamadd_db.h") o1 o2 o3 + AMADDDB II32 o1 o2 o3 -> op3 (text "\tamadd_db.w") o1 o2 o3 + AMADDDB II64 o1 o2 o3 -> op3 (text "\tamadd_db.d") o1 o2 o3 + + AMANDDB II32 o1 o2 o3 -> op3 (text "\tamand_db.w") o1 o2 o3 + AMANDDB II64 o1 o2 o3 -> op3 (text "\tamand_db.d") o1 o2 o3 + + AMORDB II32 o1 o2 o3 -> op3 (text "\tamor_db.w") o1 o2 o3 + AMORDB II64 o1 o2 o3 -> op3 (text "\tamor_db.d") o1 o2 o3 + + AMXORDB II32 o1 o2 o3 -> op3 (text "\tamxor_db.w") o1 o2 o3 + AMXORDB II64 o1 o2 o3 -> op3 (text "\tamxor_db.d") o1 o2 o3 -- AMCAS[_DB].{B/H/W/D} + AMCASDB II8 o1 o2 o3 -> op3 (text "\tamcas_db.b") o1 o2 o3 + AMCASDB II16 o1 o2 o3 -> op3 (text "\tamcas_db.h") o1 o2 o3 + AMCASDB II32 o1 o2 o3 -> op3 (text "\tamcas_db.w") o1 o2 o3 + AMCASDB II64 o1 o2 o3 -> op3 (text "\tamcas_db.d") o1 o2 o3 -- LL.{W/D}, SC.{W/D} + LL II32 o1 o2 o3 -> op3 (text "\tll.w") o1 o2 o3 + SC II32 o1 o2 o3 -> op3 (text "\tsc.w") o1 o2 o3 + LL II64 o1 o2 o3 -> op3 (text "\tll.d") o1 o2 o3 + SC II64 o1 o2 o3 -> op3 (text "\tsc.d") o1 o2 o3 -- SC.Q -- LL.ACQ.{W/D}, SC.REL.{W/D} -- 8. Barrier Instructions --------------------------------------------------- ===================================== m4/fp_check_timer_create.m4 deleted ===================================== @@ -1,110 +0,0 @@ -# Check for a working timer_create(). We need a pretty detailed check -# here, because there exist partially-working implementations of -# timer_create() in certain versions of Linux (see bug #1933). -# -AC_DEFUN([FP_CHECK_TIMER_CREATE],[ -AC_CHECK_FUNC([timer_create],[HAVE_timer_create=yes],[HAVE_timer_create=no]) - -if test "$HAVE_timer_create" = "yes" -then - if test "$cross_compiling" = "yes" - then - # We can't test timer_create when we're cross-compiling, so we - # optimistiaclly assume that it actually works properly. - AC_DEFINE([USE_TIMER_CREATE], 1, [Define to 1 if we can use timer_create(CLOCK_REALTIME,...)]) - else - AC_CACHE_CHECK([for a working timer_create(CLOCK_REALTIME)], - [fptools_cv_timer_create_works], - [AC_TRY_RUN([ -#include -#if defined(HAVE_STDLIB_H) -#include -#endif -#include -#if defined(HAVE_SIGNAL_H) -#include -#endif -#if defined(HAVE_UNISTD_H) -#include -#endif - -static volatile int tock = 0; -static void handler(int i) -{ - tock = 1; -} - -static void timeout(int i) -{ - // timer_settime() has been known to hang, so just in case - // we install a 1-second timeout (see #2257) - exit(99); -} - -int main(int argc, char *argv[]) -{ - - struct sigevent ev; - timer_t timer; - struct itimerspec it; - struct sigaction action; - int m,n,count = 0; - - ev.sigev_notify = SIGEV_SIGNAL; - ev.sigev_signo = SIGVTALRM; - - action.sa_handler = handler; - action.sa_flags = 0; - sigemptyset(&action.sa_mask); - if (sigaction(SIGVTALRM, &action, NULL) == -1) { - fprintf(stderr,"SIGVTALRM problem\n"); - exit(3); - } - - action.sa_handler = timeout; - action.sa_flags = 0; - sigemptyset(&action.sa_mask); - if (sigaction(SIGALRM, &action, NULL) == -1) { - fprintf(stderr,"SIGALRM problem\n"); - exit(3); - } - alarm(1); - - if (timer_create(CLOCK_REALTIME, &ev, &timer) != 0) { - fprintf(stderr,"No CLOCK_REALTIME timer\n"); - exit(2); - } - - tock = 0; - - it.it_value.tv_sec = 0; - it.it_value.tv_nsec = 1000000; // 1ms - it.it_interval = it.it_value; - if (timer_settime(timer, 0, &it, NULL) != 0) { - fprintf(stderr,"settime problem\n"); - exit(4); - } - - // some environments have coarse scheduler/timer granularity of ~10ms and worse - usleep(100000); // 100ms - - if (!tock) { - fprintf(stderr,"no CLOCK_REALTIME signal\n"); - exit(5); - } - - timer_delete(timer); - - exit(0); -} - ], - [fptools_cv_timer_create_works=yes], - [fptools_cv_timer_create_works=no]) - ]) -case $fptools_cv_timer_create_works in - yes) AC_DEFINE([USE_TIMER_CREATE], 1, - [Define to 1 if we can use timer_create(CLOCK_REALTIME,...)]);; -esac - fi -fi -]) ===================================== rts/Timer.c ===================================== @@ -7,12 +7,14 @@ * ---------------------------------------------------------------------------*/ /* - * The interval timer is used for profiling and for context switching in the - * threaded build. + * The interval timer is used for profiling and for context switching. * * This file defines the platform-independent view of interval timing, relying - * on platform-specific services to install and run the timers. + * on platform-specific services to install and run the timers. See + * posix/Ticker.c and win32/Ticker.c for the platform specific parts. * + * If you are looking for Itimer.c then you either file or one of the + * platform-specific Ticker.c files. */ #include "rts/PosixSource.h" ===================================== rts/configure.ac ===================================== @@ -204,7 +204,6 @@ FP_MUSTTAIL dnl ** check for librt AC_CHECK_FUNCS(clock_gettime timer_settime) -FP_CHECK_TIMER_CREATE dnl ** check for Apple's "interesting" long double compatibility scheme AC_MSG_CHECKING(for printf\$LDBLStub) ===================================== rts/include/rts/Timer.h ===================================== @@ -15,4 +15,4 @@ void startTimer (void); void stopTimer (void); -int rtsTimerSignal (void); +int rtsTimerSignal (void); // Deprecated: see issue #27073 ===================================== rts/include/stg/SMP.h ===================================== @@ -21,7 +21,7 @@ void arm_atomic_spin_unlock(void); // Unconditionally atomic operations // These are atomic even in the non-threaded RTS. These are necessary in the // Proftimer implementation, which may be called from the pthreads-based -// ITimer implementation. +// Ticker implementation. #define RELAXED_LOAD_ALWAYS(ptr) __atomic_load_n(ptr, __ATOMIC_RELAXED) #define RELAXED_STORE_ALWAYS(ptr,val) __atomic_store_n(ptr, val, __ATOMIC_RELAXED) #define RELAXED_ADD_ALWAYS(ptr,val) __atomic_add_fetch(ptr, val, __ATOMIC_RELAXED) ===================================== rts/posix/Signals.c ===================================== @@ -640,35 +640,6 @@ set_sigtstp_action (bool handle) } } -/* Used by ItimerTimerCreate and ItimerSetitimer implementations */ -void -install_vtalrm_handler(int sig, TickProc handle_tick) -{ - struct sigaction action; - memset(&action, 0, sizeof(struct sigaction)); - - action.sa_handler = handle_tick; - - sigemptyset(&action.sa_mask); - -#if defined(SA_RESTART) - // specify SA_RESTART. One consequence if we don't do this is - // that readline gets confused by the -threaded RTS. It seems - // that if a SIGALRM handler is installed without SA_RESTART, - // readline installs its own SIGALRM signal handler (see - // readline's signals.c), and this somehow causes readline to go - // wrong when the input exceeds a single line (try it). - action.sa_flags = SA_RESTART; -#else - action.sa_flags = 0; -#endif - - if (sigaction(sig, &action, NULL) == -1) { - sysErrorBelch("sigaction"); - stg_exit(EXIT_FAILURE); - } -} - /* ----------------------------------------------------------------------------- * Install default signal handlers. * ===================================== rts/posix/Signals.h ===================================== @@ -25,8 +25,6 @@ extern siginfo_t *next_pending_handler; void startSignalHandlers(Capability *cap); #endif -void install_vtalrm_handler(int sig, TickProc handle_tick); - /* Communicating with the IO manager thread (see GHC.Conc). * * TODO: these I/O manager things are not related to signals and ought to live ===================================== rts/posix/Ticker.c ===================================== @@ -2,116 +2,38 @@ * * (c) The GHC Team, 1995-2007 * - * Interval timer for profiling and pre-emptive scheduling. + * Posix implementation(s) of the interval timer for profiling and pre-emptive + * scheduling. * * ---------------------------------------------------------------------------*/ -/* - * The interval timer is used for profiling and for context switching in the - * threaded build. Though POSIX 1003.1b includes a standard interface for - * such things, no one really seems to be implementing them yet. Even - * Solaris 2.3 only seems to provide support for @CLOCK_REAL@, whereas we're - * keen on getting access to @CLOCK_VIRTUAL@. - * - * Hence, we often use the old-fashioned @setitimer@ that just about everyone - * seems to support. So much for standards. - * - * If you are looking for Itimer.c then this is the right file. I renamed it - * Ticker.c for consistency. +/* 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. + * + * Historically we had ticker implementations using signals. This was always a + * rather shakey thing to do but we 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 + * switching, but it's no good for things like flushing the eventlog, or + * waking up rts tasks. + * - We also want to avoid using alarm signals, as these can interrupt system + * calls (#10840) or can be overwritten by user code. */ -#include "rts/PosixSource.h" - -/* We've defined _POSIX_SOURCE via "rts/PosixSource.h", and yet still use - some non-POSIX features. With _POSIX_SOURCE defined, visibility of - non-POSIX extension prototypes requires _DARWIN_C_SOURCE on Mac OS X, - __BSD_VISIBLE on FreeBSD and DragonflyBSD, and _NetBSD_SOURCE on - NetBSD. Otherwise, for example, code using pthread_setname_np(3) and - variants will not compile. We must therefore define the additional - macros that expose non-POSIX APIs early, before any of the relevant - system headers are included via "Rts.h". - - An alternative approach could be to write portable wrappers or stubs for all - the non-posix functions in a C-module that does not include "rts/PosixSource.h", - and then use only POSIX features and the portable wrapper functions in all - other C-modules. */ -#include "ghcconfig.h" -#if defined(freebsd_HOST_OS) || defined(dragonfly_HOST_OS) -#define __BSD_VISIBLE 1 -#endif -#if defined(darwin_HOST_OS) -#define _DARWIN_C_SOURCE 1 -#endif -#if defined(netbsd_HOST_OS) -#define _NETBSD_SOURCE 1 -#endif - -#include "Rts.h" - -/* - * It used to be that timer_create doesn't exist on iOS and setitimer doesn't fire on iOS - * during debugging. See #7723. Seems to be an issue with signals. - * - * We also want to avoid using alarm signals, as these can interrupt system calls (#10840) - * or can be overwritten by user code. +/* Select a ticker implementation to use: * - * So we are using the pthread based implementation. - */ -#if defined(ios_HOST_OS) || defined(darwin_HOST_OS) -#define USE_PTHREAD_FOR_ITIMER -#endif - -/* - * On Linux we can use timerfd_* (introduced in Linux - * 2.6.25) and a thread instead of alarm signals. It avoids the risk of - * interrupting syscalls (see #10840) and the risk of being accidentally - * modified in user code using signals. NetBSD has also added timerfd - * support since version 10. + * 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/netbsd without timerfd we fall back to the - * pthread based implementation. + * For older version of linux/bsd without timerfd, and for all other posix + * platforms, we use the implementation using posix pthreads and nanosleep(). */ #if defined(HAVE_SYS_TIMERFD_H) -#define USE_TIMERFD_FOR_ITIMER -#endif - -#if defined(linux_HOST_OS) -#define USE_PTHREAD_FOR_ITIMER -#endif - -#if defined(netbsd_HOST_OS) -#define USE_PTHREAD_FOR_ITIMER -#endif - -#if defined(freebsd_HOST_OS) -#define USE_PTHREAD_FOR_ITIMER -#endif - -#if defined(solaris2_HOST_OS) -/* USE_TIMER_CREATE is usually disabled for Solaris. In fact it is - supported well on this OS, but requires additional privilege. When - user does not have it, then the testing configure program fails - which results in USE_TIMER_CREATE not defined. - On the other hand when we cross-compile, then we optimistically - assume usage of timer_create function. The problem is that if we - cross compile for example from i386-solaris2 to x86_64-solaris2, - then the build fails with error like this: - -ghc-stage2: timer_create: Not owner - - which happens on first ghc-stage2 invocation. So to support - cross-compilation to Solaris we manually undefine USE_TIMER_CREATE - here */ -#undef USE_TIMER_CREATE -#endif /* solaris2_HOST_OS */ - -// Select the variant to use -#if defined(USE_TIMERFD_FOR_ITIMER) #include "ticker/TimerFd.c" -#elif defined(USE_PTHREAD_FOR_ITIMER) -#include "ticker/Pthread.c" -#elif defined(USE_TIMER_CREATE) -#include "ticker/TimerCreate.c" #else -#include "ticker/Setitimer.c" +#include "ticker/Pthread.c" #endif ===================================== rts/posix/ticker/Setitimer.c deleted ===================================== @@ -1,80 +0,0 @@ -/* ----------------------------------------------------------------------------- - * - * (c) The GHC Team, 1995-2007 - * - * Interval timer for profiling and pre-emptive scheduling. - * - * ---------------------------------------------------------------------------*/ - -#include "rts/PosixSource.h" -#include "Rts.h" - -#include "Ticker.h" -#include "Proftimer.h" -#include "Schedule.h" -#include "posix/Clock.h" -#include "posix/Signals.h" - -#include -#if HAVE_SYS_TIME_H -# include -#endif - -#if defined(HAVE_SIGNAL_H) -# include -#endif - -#include - -static Time itimer_interval = DEFAULT_TICK_INTERVAL; - -void -initTicker (Time interval, TickProc handle_tick) -{ - itimer_interval = interval; - install_vtalrm_handler(SIGALRM, handle_tick); -} - -void -startTicker(void) -{ - struct itimerval it; - - it.it_value.tv_sec = TimeToSeconds(itimer_interval); - it.it_value.tv_usec = TimeToUS(itimer_interval) % 1000000; - it.it_interval = it.it_value; - - if (setitimer(ITIMER_REAL, &it, NULL) != 0) { - sysErrorBelch("setitimer"); - stg_exit(EXIT_FAILURE); - } -} - -void -stopTicker(void) -{ - struct itimerval it; - - it.it_value.tv_sec = 0; - it.it_value.tv_usec = 0; - it.it_interval = it.it_value; - - if (setitimer(ITIMER_REAL, &it, NULL) != 0) { - sysErrorBelch("setitimer"); - stg_exit(EXIT_FAILURE); - } -} - -void -exitTicker (bool wait STG_UNUSED) -{ - return; -} - -int -rtsTimerSignal(void) -{ - return SIGALRM; - // Using SIGALRM can leads to problems, see #850. But we have no - // option if timer_create() is not available. -} ===================================== rts/posix/ticker/TimerCreate.c deleted ===================================== @@ -1,92 +0,0 @@ -/* ----------------------------------------------------------------------------- - * - * (c) The GHC Team, 1995-2007 - * - * Interval timer for profiling and pre-emptive scheduling. - * - * ---------------------------------------------------------------------------*/ - -#include "rts/PosixSource.h" -#include "Rts.h" - -#include "Ticker.h" -#include "Proftimer.h" -#include "Schedule.h" -#include "posix/Clock.h" -#include "posix/Signals.h" - -#if defined(HAVE_SIGNAL_H) -# include -#endif - -#include - -static Time itimer_interval = DEFAULT_TICK_INTERVAL; -static timer_t timer; - -void -initTicker (Time interval, TickProc handle_tick) -{ - itimer_interval = interval; - - struct sigevent ev; - - // Keep programs like valgrind happy - memset(&ev, 0, sizeof(ev)); - - ev.sigev_notify = SIGEV_SIGNAL; - ev.sigev_signo = SIGVTALRM; - - if (timer_create(CLOCK_ID, &ev, &timer) != 0) { - sysErrorBelch("timer_create"); - stg_exit(EXIT_FAILURE); - } - - install_vtalrm_handler(SIGVTALRM, handle_tick); -} - -void -startTicker(void) -{ - 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 (timer_settime(timer, 0, &it, NULL) != 0) { - sysErrorBelch("timer_settime"); - stg_exit(EXIT_FAILURE); - } -} - -void -stopTicker(void) -{ - struct itimerspec it; - - it.it_value.tv_sec = 0; - it.it_value.tv_nsec = 0; - it.it_interval = it.it_value; - - if (timer_settime(timer, 0, &it, NULL) != 0) { - sysErrorBelch("timer_settime"); - stg_exit(EXIT_FAILURE); - } -} - -void -exitTicker (bool wait STG_UNUSED) -{ - // Before deleting the timer set the signal to ignore to avoid the - // possibility of the signal being delivered after the timer is deleted. - signal(SIGVTALRM, SIG_IGN); - timer_delete(timer); - // ignore errors - we don't really care if it fails. -} - -int -rtsTimerSignal(void) -{ - return SIGVTALRM; -} ===================================== testsuite/tests/perf/compiler/T13960.hs ===================================== @@ -0,0 +1,72 @@ +{-# LANGUAGE OverloadedStrings #-} + +-- GHC used to run out of simplifier ticks due to inlining the internals of +-- `toStrict . toLazyByteString`. +module T13960 (breaks) where + +import Data.ByteString (ByteString) +import Data.ByteString.Builder (Builder, stringUtf8, toLazyByteString) +import Data.ByteString.Lazy (toStrict) +import Data.String (IsString(..)) + +newtype Query = Query ByteString + +toByteString :: Builder -> ByteString +toByteString x = toStrict (toLazyByteString x) + +instance IsString Query where + fromString = Query . toByteString . stringUtf8 + +breaks :: [(Query, Query)] +breaks = + [ ("query001a", "query001b") + , ("query002a", "query002b") + , ("query003a", "query003b") + , ("query004a", "query004b") + , ("query005a", "query005b") + , ("query006a", "query006b") + , ("query007a", "query007b") + , ("query008a", "query008b") + , ("query009a", "query009b") + , ("query010a", "query010b") + , ("query011a", "query011b") + , ("query012a", "query012b") + , ("query013a", "query013b") + , ("query014a", "query014b") + , ("query015a", "query015b") + , ("query016a", "query016b") + , ("query017a", "query017b") + , ("query018a", "query018b") + , ("query019a", "query019b") + , ("query020a", "query020b") + , ("query021a", "query021b") + , ("query022a", "query022b") + , ("query023a", "query023b") + , ("query024a", "query024b") + , ("query025a", "query025b") + , ("query026a", "query026b") + , ("query027a", "query027b") + , ("query028a", "query028b") + , ("query029a", "query029b") + , ("query030a", "query030b") + , ("query031a", "query031b") + , ("query032a", "query032b") + , ("query033a", "query033b") + , ("query034a", "query034b") + , ("query035a", "query035b") + , ("query036a", "query036b") + , ("query037a", "query037b") + , ("query038a", "query038b") + , ("query039a", "query039b") + , ("query040a", "query040b") + , ("query041a", "query041b") + , ("query042a", "query042b") + , ("query043a", "query043b") + , ("query044a", "query044b") + , ("query045a", "query045b") + , ("query046a", "query046b") + , ("query047a", "query047b") + , ("query048a", "query048b") + , ("query049a", "query049b") + , ("query050a", "query050b") + ] ===================================== testsuite/tests/perf/compiler/all.T ===================================== @@ -686,6 +686,12 @@ test ('T13820', ], compile, ['-v0']) +test ('T13960', + [ collect_compiler_stats('peak_megabytes_allocated', 20), + collect_compiler_stats('bytes allocated', 2), + ], + compile, + ['-O']) test ('T14766', [ collect_compiler_stats('bytes allocated',2), pre_cmd('python3 genT14766.py > T14766.hs'), View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/c7ac6d41fb981364ec50b914965f75c... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/c7ac6d41fb981364ec50b914965f75c... You're receiving this email because of your account on gitlab.haskell.org.