[Git][ghc/ghc][wip/fendor/hpc-bc-support] Make HPC work with bytecode interpreter
by Hannes Siebenhandl (＠fendor) 02 Apr '26
by Hannes Siebenhandl (＠fendor) 02 Apr '26
02 Apr '26
Hannes Siebenhandl pushed to branch wip/fendor/hpc-bc-support at Glasgow Haskell Compiler / GHC
Commits:
7af98e18 by fendor at 2026-04-02T12:06:11+02:00
Make HPC work with bytecode interpreter
Add support to generate .tix files from bytecode objects and the
bytecode interpreter.
Conceptually, we insert HPC ticks into the bytecode similar to how we insert
breakpoints.
HPC and breakpoints do not share the same tick array but we use a separate
tick-array for hpc/breakpoint ticks during bytecode generation.
We teach the bytecode interpreter to handle hpc ticks.
The implementation is quite trivial, simply increment the counter in the
global hpc_ticks array for the respective module.
This hpc_ticks array is generated as part of the `CStub`, so we can rely
on it existing.
A tricky bit is "registering" a bytecode object for HPC instrumentation.
In the compiled case, this is achieved via CStub and initializer/finalizers
`.init` sections which are called when the executable is run.
After the initializers have been invoked, which is before `hs_init_ghc`,
we then call `startup_hpc` in `hs_init_ghc` iff any modules were "registered"
for hpc instrumentation via `hs_hpc_module`.
Since bytecode objects are loaded after starting up GHCi, this workflow
doesn't work for supporting `hpc` and the `hpc` run-time is never
started, even if a module is added for instrumentation.
We fix this issue by employing the same technique as is for `SptEntry`s:
* We introduce a new field to `CompiledByteCode`, called `ByteCodeHpcInfo`
which contains enough information to call `hs_hpc_module`, allowing us to
register the module for `hpc` instrumentation`.
* After registering the module, we unconditionally call `startupHpc`, to make
sure the .tix file is written.
Calling `startupHpc` multiple times is safe.
Calling `hs_hpc_module` multiple times for the same module is also safe.
Evaluating a bytecode object instrumented with `-fhpc` without registering it
in the `hpc` run-time will simply not generate any `.tix` files for this
bytecode object.
Closes #27036
- - - - -
29 changed files:
- compiler/GHC/ByteCode/Asm.hs
- compiler/GHC/ByteCode/Binary.hs
- compiler/GHC/ByteCode/Instr.hs
- compiler/GHC/ByteCode/Types.hs
- compiler/GHC/Driver/Backend.hs
- compiler/GHC/Driver/CodeOutput.hs
- compiler/GHC/Driver/Main.hs
- compiler/GHC/Driver/Session.hs
- compiler/GHC/HsToCore.hs
- compiler/GHC/HsToCore/Coverage.hs
- compiler/GHC/HsToCore/Ticks.hs
- compiler/GHC/Iface/Tidy.hs
- compiler/GHC/Linker/Loader.hs
- compiler/GHC/Runtime/Interpreter.hs
- compiler/GHC/StgToByteCode.hs
- compiler/GHC/Types/HpcInfo.hs
- compiler/GHC/Unit/Module/ModGuts.hs
- + libraries/ghci/GHCi/Coverage.hs
- libraries/ghci/GHCi/Message.hs
- libraries/ghci/GHCi/Run.hs
- libraries/ghci/ghci.cabal.in
- rts/Disassembler.c
- rts/Hpc.c
- rts/Interpreter.c
- rts/include/rts/Bytecodes.h
- + testsuite/tests/hpc/ghc_ghci/BytecodeMain.hs
- testsuite/tests/hpc/ghc_ghci/Makefile
- + testsuite/tests/hpc/ghc_ghci/hpc_ghc_ghci_bytecode.stdout
- testsuite/tests/hpc/ghc_ghci/test.T
Changes:
=====================================
compiler/GHC/ByteCode/Asm.hs
=====================================
@@ -72,6 +72,7 @@ import GHC.Float (castFloatToWord32, castDoubleToWord64)
import qualified Data.List as List ( any )
import GHC.Exts
+import qualified GHC.Data.Strict as Strict
-- -----------------------------------------------------------------------------
@@ -111,8 +112,9 @@ assembleBCOs
-> [(Name, ByteString)]
-> Maybe InternalModBreaks
-> [SptEntry]
+ -> Strict.Maybe ByteCodeHpcInfo
-> IO CompiledByteCode
-assembleBCOs profile proto_bcos tycons top_strs modbreaks spt_entries = do
+assembleBCOs profile proto_bcos tycons top_strs modbreaks spt_entries use_hpc = do
-- TODO: the profile should be bundled with the interpreter: the rts ways are
-- fixed for an interpreter
let itbls = mkITbls profile tycons
@@ -123,6 +125,7 @@ assembleBCOs profile proto_bcos tycons top_strs modbreaks spt_entries = do
, bc_strs = top_strs
, bc_breaks = modbreaks
, bc_spt_entries = spt_entries
+ , bc_hpc_info = use_hpc
}
-- Note [Allocating string literals]
@@ -856,6 +859,12 @@ assembleI platform i = case i of
emit_ bci_BRK_FUN [ Op p1, Op info_addr, Op info_unitid_addr
, SmallOp ix_hi, SmallOp ix_lo, Op np ]
+ HPC_TICK lbl ix -> do
+ p <- lit1 (BCONPtrLbl lbl)
+ let ix_hi = fromIntegral (ix `shiftR` 16)
+ ix_lo = fromIntegral (ix .&. 0xffff)
+ emit_ bci_HPC_TICK [Op p, SmallOp ix_hi, SmallOp ix_lo]
+
#if MIN_VERSION_rts(1,0,3)
BCO_NAME name -> do np <- lit1 (BCONPtrStr name)
emit_ bci_BCO_NAME [Op np]
=====================================
compiler/GHC/ByteCode/Binary.hs
=====================================
@@ -135,13 +135,15 @@ instance Binary CompiledByteCode where
replicateM bc_strs_len $ (,) <$> getViaBinName bh <*> get bh
bc_breaks <- get bh
bc_spt_entries <- get bh
+ bc_hpc_info <- get bh
return $
CompiledByteCode
{ bc_bcos,
bc_itbls,
bc_strs,
bc_breaks,
- bc_spt_entries
+ bc_spt_entries,
+ bc_hpc_info
}
put_ bh CompiledByteCode {..} = do
@@ -154,6 +156,26 @@ instance Binary CompiledByteCode where
for_ bc_strs $ \(nm, str) -> putViaBinName bh nm *> put_ bh str
put_ bh bc_breaks
put_ bh bc_spt_entries
+ put_ bh bc_hpc_info
+
+instance Binary ByteCodeHpcInfo where
+ put_ bh ByteCodeHpcInfo{bchi_tick_count,bchi_hash,bchi_tickbox_name,bchi_module_name} = do
+ put_ bh bchi_module_name
+ put_ bh bchi_tickbox_name
+ put_ bh bchi_tick_count
+ put_ bh bchi_hash
+
+ get bh = do
+ bchi_module_name <- get bh
+ bchi_tickbox_name <- get bh
+ bchi_tick_count <- get bh
+ bchi_hash <- get bh
+ pure ByteCodeHpcInfo
+ { bchi_tick_count
+ , bchi_hash
+ , bchi_tickbox_name
+ , bchi_module_name
+ }
instance Binary UnlinkedBCO where
get bh =
=====================================
compiler/GHC/ByteCode/Instr.hs
=====================================
@@ -15,6 +15,7 @@ import GHC.ByteCode.Types
import GHC.Cmm.Type (Width)
import GHC.StgToCmm.Layout ( ArgRep(..) )
import GHC.Utils.Outputable
+import GHC.Data.FastString ( FastString )
import GHC.Types.Name
import GHC.Types.Literal
import GHC.Types.Unique
@@ -257,6 +258,7 @@ data BCInstr
-- Breakpoints
| BRK_FUN !InternalBreakpointId
+ | HPC_TICK !FastString !Word32
#if MIN_VERSION_rts(1,0,3)
-- | A "meta"-instruction for recording the name of a BCO for debugging purposes.
@@ -452,6 +454,7 @@ instance Outputable BCInstr where
= text "BRK_FUN" <+> text "<breakarray>"
<+> ppr info_mod <+> ppr infox
<+> text "<cc>"
+ ppr (HPC_TICK lbl ix) = text "HPC_TICK" <+> ppr lbl <+> ppr ix
#if MIN_VERSION_rts(1,0,3)
ppr (BCO_NAME nm) = text "BCO_NAME" <+> text (show nm)
#endif
@@ -578,6 +581,7 @@ bciStackUse OP_INDEX_ADDR{} = 0
bciStackUse SWIZZLE{} = 0
bciStackUse BRK_FUN{} = 0
+bciStackUse HPC_TICK{} = 0
-- These insns actually reduce stack use, but we need the high-tide level,
-- so can't use this info. Not that it matters much.
=====================================
compiler/GHC/ByteCode/Types.hs
=====================================
@@ -25,6 +25,9 @@ module GHC.ByteCode.Types
-- * Mod Breaks
, ModBreaks (..), BreakpointId(..), BreakTickIndex
+ -- * Hpc Info
+ , ByteCodeHpcInfo(..)
+
-- * Internal Mod Breaks
, InternalModBreaks(..), CgBreakInfo(..), seqInternalModBreaks
-- ** Internal breakpoint identifier
@@ -35,6 +38,7 @@ import GHC.Prelude
import GHC.Data.FastString
import GHC.Data.FlatBag
+import qualified GHC.Data.Strict as Strict
import GHC.Types.Name
import GHC.Types.Name.Env
import GHC.Utils.Binary
@@ -79,6 +83,25 @@ data CompiledByteCode = CompiledByteCode
-- ^ Static pointer table entries which should be loaded along with the
-- BCOs. See Note [Grand plan for static forms] in
-- "GHC.Iface.Tidy.StaticPtrTable".
+
+ , bc_hpc_info :: !(Strict.Maybe ByteCodeHpcInfo)
+ -- ^ 'ByteCodeHpcInfo' that should be added to the run-time system when this 'CompiledByteCode'
+ -- object is loaded.
+ --
+ -- It is safe to load the same 'ByteCodeHpcInfo' multiple times.
+ }
+
+-- | ByteCode specific HPC information.
+--
+data ByteCodeHpcInfo = ByteCodeHpcInfo
+ { bchi_module_name :: !String
+ -- ^ Name of the module.
+ , bchi_tickbox_name :: !String
+ -- ^ Name of the tick box that has been added via 'CStub'.
+ , bchi_tick_count :: {-# UNPACK #-} !Int
+ -- ^ Number of ticks.
+ , bchi_hash :: {-# UNPACK #-} !Int
+ -- ^ mix-file hash.
}
-- | A libffi ffi_cif function prototype.
=====================================
compiler/GHC/Driver/Backend.hs
=====================================
@@ -712,8 +712,7 @@ backendSupportsHpc (Named NCG) = True
backendSupportsHpc (Named LLVM) = True
backendSupportsHpc (Named ViaC) = True
backendSupportsHpc (Named JavaScript) = False
--- TODO: @terrorjack thinks that the bytecode backend should support HPC now since (!13493)
-backendSupportsHpc (Named Bytecode) = False
+backendSupportsHpc (Named Bytecode) = True
backendSupportsHpc (Named NoBackend) = True
-- | This flag says whether the back end supports foreign
=====================================
compiler/GHC/Driver/CodeOutput.hs
=====================================
@@ -343,7 +343,6 @@ outputForeignStubs logger tmpfs dflags unit_state mod location stubs
cplusplus_hdr = "#if defined(__cplusplus)\nextern \"C\" {\n#endif\n"
cplusplus_ftr = "#if defined(__cplusplus)\n}\n#endif\n"
-
-- It is more than likely that the stubs file will
-- turn out to be empty, in which case no file should be created.
outputForeignStubs_help :: FilePath -> String -> String -> String -> IO Bool
=====================================
compiler/GHC/Driver/Main.hs
=====================================
@@ -134,6 +134,7 @@ import GHC.Driver.Config.Diagnostic
import GHC.Driver.Config.Tidy
import GHC.Driver.Hooks
import GHC.Driver.GenerateCgIPEStub (generateCgIPEStub, lookupEstimatedTicks)
+import GHC.Driver.Ppr (showSDoc)
import GHC.Runtime.Context
import GHC.Runtime.Interpreter
@@ -151,6 +152,7 @@ import GHC.Hs.Dump
import GHC.Hs.Stats ( ppSourceStats )
import GHC.HsToCore
+import GHC.HsToCore.Coverage ( hpcTickBoxes, hpcModuleName )
import GHC.StgToByteCode ( byteCodeGen )
import GHC.StgToJS ( stgToJS )
@@ -207,6 +209,8 @@ import qualified GHC.StgToCmm as StgToCmm ( codeGen )
import GHC.StgToCmm.Types (CmmCgInfos (..), ModuleLFInfos, LambdaFormInfo(..))
import GHC.StgToCmm.CgUtils (CgStream)
+import qualified GHC.ByteCode.Serialize as ByteCode
+
import GHC.Cmm
import GHC.Cmm.Info.Build
import GHC.Cmm.Pipeline
@@ -237,6 +241,7 @@ import GHC.Types.Var.Set
import GHC.Types.Error
import GHC.Types.Fixity.Env
import GHC.Types.CostCentre
+import GHC.Types.HpcInfo (HpcInfo (..))
import GHC.Types.IPE
import GHC.Types.SourceFile
import GHC.Types.SrcLoc
@@ -260,6 +265,7 @@ import GHC.Utils.Touch
import GHC.Data.FastString
import GHC.Data.Bag
import GHC.Data.OsPath (unsafeEncodeUtf)
+import qualified GHC.Data.Strict as Strict
import GHC.Data.StringBuffer
import qualified GHC.Data.Stream as Stream
import GHC.Data.Maybe
@@ -297,7 +303,6 @@ import GHC.Cmm.Config (CmmConfig)
import Data.Bifunctor
import qualified GHC.Unit.Home.Graph as HUG
import GHC.Unit.Home.PackageTable
-import qualified GHC.ByteCode.Serialize as ByteCode
{- **********************************************************************
%* *
@@ -1185,7 +1190,7 @@ compileWholeCoreBindings hsc_env type_env wcb = do
gen_bytecode core_binds stubs foreign_files = do
let cgi_guts = CgInteractiveGuts wcb_module core_binds
(typeEnvTyCons type_env) stubs foreign_files
- Nothing []
+ Nothing [] NoHpcInfo
trace_if logger (text "Generating ByteCode for" <+> ppr wcb_module)
mkModuleByteCode hsc_env wcb_module wcb_mod_location cgi_guts
@@ -2135,11 +2140,12 @@ data CgInteractiveGuts = CgInteractiveGuts { cgi_module :: Module
, cgi_foreign_files :: [(ForeignSrcLang, FilePath)]
, cgi_modBreaks :: Maybe ModBreaks
, cgi_spt_entries :: [SptEntry]
+ , cgi_hpc_info :: HpcInfo
}
mkCgInteractiveGuts :: CgGuts -> CgInteractiveGuts
-mkCgInteractiveGuts CgGuts{cg_module, cg_binds, cg_tycons, cg_foreign, cg_foreign_files, cg_modBreaks, cg_spt_entries}
- = CgInteractiveGuts cg_module cg_binds cg_tycons cg_foreign cg_foreign_files cg_modBreaks cg_spt_entries
+mkCgInteractiveGuts CgGuts{cg_module, cg_binds, cg_tycons, cg_foreign, cg_foreign_files, cg_modBreaks, cg_spt_entries, cg_hpc_info}
+ = CgInteractiveGuts cg_module cg_binds cg_tycons cg_foreign cg_foreign_files cg_modBreaks cg_spt_entries cg_hpc_info
hscInteractive :: HscEnv
-> CgInteractiveGuts
@@ -2162,13 +2168,15 @@ hscGenerateByteCode :: HscEnv -> CgInteractiveGuts -> ModLocation -> IO Compiled
hscGenerateByteCode hsc_env cgguts location = do
let dflags = hsc_dflags hsc_env
let logger = hsc_logger hsc_env
+ let platform = targetPlatform dflags
let CgInteractiveGuts{ -- This is the last use of the ModGuts in a compilation.
-- From now on, we just use the bits we need.
cgi_module = this_mod,
cgi_binds = core_binds,
cgi_tycons = tycons,
cgi_modBreaks = mod_breaks,
- cgi_spt_entries = spt_entries } = cgguts
+ cgi_spt_entries = spt_entries,
+ cgi_hpc_info = hpc_info } = cgguts
-------------------
-- ADD IMPLICIT BINDINGS
@@ -2193,8 +2201,22 @@ hscGenerateByteCode hsc_env cgguts location = do
let (stg_binds,_stg_deps) = unzip stg_binds_with_deps
+ -------------------
+ -- Setup HPC info
+ let
+ -- Strict to not retain a reference to the 'cgguts' via 'hpc_info'
+ !bytecodeHpcInfo = case hpc_info of
+ NoHpcInfo -> Strict.Nothing
+ HpcInfo{hpcInfoTickCount, hpcInfoHash} ->
+ Strict.Just ByteCodeHpcInfo
+ { bchi_tick_count = hpcInfoTickCount
+ , bchi_hash = hpcInfoHash
+ , bchi_tickbox_name = showSDoc dflags $ hpcTickBoxes platform this_mod
+ , bchi_module_name = showSDoc dflags $ hpcModuleName this_mod
+ }
+
----------------- Generate byte code ------------------
- byteCodeGen hsc_env this_mod stg_binds tycons mod_breaks spt_entries
+ byteCodeGen hsc_env this_mod stg_binds tycons mod_breaks spt_entries bytecodeHpcInfo
-- | Generate a byte code object linkable and write it to a file if `-fwrite-byte-code` is enabled.
generateAndWriteByteCode :: HscEnv -> CgInteractiveGuts -> ModLocation -> IO ModuleByteCode
@@ -2843,6 +2865,7 @@ hscCompileCoreExpr' hsc_env srcspan ds_expr = do
[]
Nothing -- modbreaks
[] -- spt entries
+ Strict.Nothing -- no hpc info
{- load it -}
bco_time <- getCurrentTime
=====================================
compiler/GHC/Driver/Session.hs
=====================================
@@ -3791,12 +3791,6 @@ makeDynFlagsConsistent dflags
pgmError (backendDescription (backend dflags) ++
" supports only unregisterised ABI but target platform doesn't use it.")
- | gopt Opt_Hpc dflags && not (backendSupportsHpc (backend dflags))
- = let dflags' = gopt_unset dflags Opt_Hpc
- warn = "Hpc can't be used with " ++ backendDescription (backend dflags) ++
- ". Ignoring -fhpc."
- in loop dflags' warn
-
| backendSwappableWithViaC (backend dflags) &&
platformUnregisterised (targetPlatform dflags)
= loop (dflags { backend = viaCBackend })
=====================================
compiler/GHC/HsToCore.hs
=====================================
@@ -163,20 +163,20 @@ deSugar hsc_env
export_set (typeEnvTyCons type_env) binds
else return (binds, Nothing)
; let modBreaks
- | Just (_, specs) <- m_tickInfo
+ | Just (_, _, breakpointSpecs) <- m_tickInfo
, breakpointsAllowed dflags
- = Just $ mkModBreaks (interpreterProfiled $ hscInterp hsc_env) mod specs
+ = Just $ mkModBreaks (interpreterProfiled $ hscInterp hsc_env) mod breakpointSpecs
| otherwise
= Nothing
; ds_hpc_info <- case m_tickInfo of
- Just (orig_file2, ticks)
+ Just (orig_file2, hpcTicks, _)
| gopt Opt_Hpc $ hsc_dflags hsc_env
-> do
hashNo <- if gopt Opt_Hpc $ hsc_dflags hsc_env
- then writeMixEntries (hpcDir dflags) mod ticks orig_file2
+ then writeMixEntries (hpcDir dflags) mod hpcTicks orig_file2
else return 0 -- dummy hash when none are written
- pure $ HpcInfo (fromIntegral $ sizeSS ticks) hashNo
+ pure $ HpcInfo (fromIntegral $ sizeSS hpcTicks) hashNo
_ -> pure $ emptyHpcInfo
; (msgs, mb_res) <- initDs hsc_env tcg_env $
=====================================
compiler/GHC/HsToCore/Coverage.hs
=====================================
@@ -6,6 +6,9 @@
module GHC.HsToCore.Coverage
( writeMixEntries
, hpcInitCode
+ , hpcStubLabel
+ , hpcModuleName
+ , hpcTickBoxes
) where
import GHC.Prelude as Prelude
@@ -116,24 +119,33 @@ hpcInitCode _ _ (NoHpcInfo {}) = mempty
hpcInitCode platform this_mod (HpcInfo tickCount hashNo)
= initializerCStub platform fn_name decls body
where
- fn_name = mkInitializerStubLabel this_mod (fsLit "hpc")
+ fn_name = hpcStubLabel this_mod
decls = text "StgWord64 " <> tickboxes <> brackets (int tickCount) <> semi
body = text "hs_hpc_module" <>
parens (hcat (punctuate comma [
- doubleQuotes full_name_str,
+ doubleQuotes (hpcModuleName this_mod),
int tickCount, -- really StgWord32
int hashNo, -- really StgWord32
tickboxes
])) <> semi
+ tickboxes = hpcTickBoxes platform this_mod
- tickboxes = pprCLabel platform (mkHpcTicksLabel $ this_mod)
-
- module_name = hcat (map (text.charToC) $ BS.unpack $
- bytesFS (moduleNameFS (moduleName this_mod)))
- package_name = hcat (map (text.charToC) $ BS.unpack $
- bytesFS (unitFS (moduleUnit this_mod)))
- full_name_str
- | moduleUnit this_mod == mainUnit
- = module_name
- | otherwise
- = package_name <> char '/' <> module_name
+hpcStubLabel :: Module -> CLabel
+hpcStubLabel this_mod = mkInitializerStubLabel this_mod (fsLit "hpc")
+
+hpcModuleName :: Module -> SDoc
+hpcModuleName this_mod = full_name_str
+ where
+ full_name_str
+ | moduleUnit this_mod == mainUnit
+ = module_name
+ | otherwise
+ = package_name <> char '/' <> module_name
+ module_name = hcat (map (text.charToC) $ BS.unpack $
+ bytesFS (moduleNameFS (moduleName this_mod)))
+
+ package_name = hcat (map (text.charToC) $ BS.unpack $
+ bytesFS (unitFS (moduleUnit this_mod)))
+
+hpcTickBoxes :: Platform -> Module -> SDoc
+hpcTickBoxes platform this_mod = pprCLabel platform (mkHpcTicksLabel this_mod)
=====================================
compiler/GHC/HsToCore/Ticks.hs
=====================================
@@ -100,7 +100,7 @@ addTicksToBinds
-- hasn't set it), so we have to work from this set.
-> [TyCon] -- ^ Type constructors in this module
-> LHsBinds GhcTc
- -> IO (LHsBinds GhcTc, Maybe (FilePath, SizedSeq Tick))
+ -> IO (LHsBinds GhcTc, Maybe (FilePath, SizedSeq Tick, SizedSeq Tick))
addTicksToBinds logger cfg
mod mod_loc exports tyCons binds
@@ -133,12 +133,13 @@ addTicksToBinds logger cfg
(binds1,st) = foldr tickPass (binds, initTTState) passes
- extendedMixEntries = ticks st
+ hpcEntries = hpcTicks st
+ breakpointEntries = breakpointTicks st
putDumpFileMaybe logger Opt_D_dump_ticked "HPC" FormatHaskell
(pprLHsBinds binds1)
- return (binds1, Just (orig_file2, extendedMixEntries))
+ return (binds1, Just (orig_file2, hpcEntries, breakpointEntries))
| otherwise = return (binds, Nothing)
@@ -1050,23 +1051,31 @@ addTickArithSeqInfo (FromThenTo e1 e2 e3) =
(addTickLHsExpr e2)
(addTickLHsExpr e3)
-data TickTransState = TT { ticks :: !(SizedSeq Tick)
- , ccIndices :: !CostCentreState
- , recSelTicks :: !(IdEnv CoreTickish)
+data TickTransState = TT { hpcTicks :: !(SizedSeq Tick)
+ , breakpointTicks :: !(SizedSeq Tick)
+ , ccIndices :: !CostCentreState
+ , recSelTicks :: !(IdEnv CoreTickish)
}
initTTState :: TickTransState
-initTTState = TT { ticks = emptySS
- , ccIndices = newCostCentreState
- , recSelTicks = emptyVarEnv
+initTTState = TT { hpcTicks = emptySS
+ , breakpointTicks = emptySS
+ , ccIndices = newCostCentreState
+ , recSelTicks = emptyVarEnv
}
-addMixEntry :: Tick -> TM Int
-addMixEntry ent = do
- c <- fromIntegral . sizeSS . ticks <$> getState
+addHpcEntry :: Tick -> TM Int
+addHpcEntry ent = do
+ c <- fromIntegral . sizeSS . hpcTicks <$> getState
setState $ \st ->
- st { ticks = addToSS (ticks st) ent
- }
+ st { hpcTicks = addToSS (hpcTicks st) ent }
+ return c
+
+addBreakpointEntry :: Tick -> TM Int
+addBreakpointEntry ent = do
+ c <- fromIntegral . sizeSS . breakpointTicks <$> getState
+ setState $ \st ->
+ st { breakpointTicks = addToSS (breakpointTicks st) ent }
return c
addRecSelTick :: Id -> CoreTickish -> TM ()
@@ -1291,7 +1300,7 @@ mkTickish boxLabel countEntries topOnly pos fvs decl_path = do
env <- getEnv
case tickishType env of
- HpcTicks -> HpcTick (this_mod env) <$> addMixEntry me
+ HpcTicks -> HpcTick (this_mod env) <$> addHpcEntry me
ProfNotes -> do
flavour <- mkHpcCCFlavour <$> getCCIndexM cc_name
@@ -1300,7 +1309,7 @@ mkTickish boxLabel countEntries topOnly pos fvs decl_path = do
return $ ProfNote cc count True{-scopes-}
Breakpoints -> do
- i <- addMixEntry me
+ i <- addBreakpointEntry me
pure (Breakpoint noExtField (BreakpointId (this_mod env) i) ids)
SourceNotes | RealSrcSpan pos' _ <- pos ->
@@ -1325,19 +1334,19 @@ mkBinTickBoxHpc :: (Bool -> BoxLabel) -> SrcSpan -> LHsExpr GhcTc
mkBinTickBoxHpc boxLabel pos e = do
env <- getEnv
binTick <- HsBinTick
- <$> addMixEntry (Tick { tick_loc = pos
+ <$> addHpcEntry (Tick { tick_loc = pos
, tick_path = declPath env
, tick_ids = []
, tick_label = boxLabel True
})
- <*> addMixEntry (Tick { tick_loc = pos
+ <*> addHpcEntry (Tick { tick_loc = pos
, tick_path = declPath env
, tick_ids = []
, tick_label = boxLabel False
})
<*> pure e
tick <- HpcTick (this_mod env)
- <$> addMixEntry (Tick { tick_loc = pos
+ <$> addHpcEntry (Tick { tick_loc = pos
, tick_path = declPath env
, tick_ids = []
, tick_label = ExpBox False
=====================================
compiler/GHC/Iface/Tidy.hs
=====================================
@@ -402,6 +402,7 @@ tidyProgram opts (ModGuts { mg_module = mod
, mg_foreign_files = foreign_files
, mg_modBreaks = modBreaks
, mg_boot_exports = boot_exports
+ , mg_hpc_info = hpc_info
}) = do
(unfold_env, tidy_occ_env) <- chooseExternalIds opts mod tcs binds imp_rules
@@ -471,6 +472,7 @@ tidyProgram opts (ModGuts { mg_module = mod
, cg_dep_pkgs = S.map snd (dep_direct_pkgs deps)
, cg_modBreaks = modBreaks
, cg_spt_entries = spt_entries
+ , cg_hpc_info = hpc_info
}
, ModDetails { md_types = tidy_type_env
, md_rules = tidy_rules
=====================================
compiler/GHC/Linker/Loader.hs
=====================================
@@ -65,9 +65,10 @@ import GHCi.RemoteTypes
import GHC.Iface.Load
import GHCi.Message
+import GHC.ByteCode.Asm
import GHC.ByteCode.Breakpoints
import GHC.ByteCode.Linker
-import GHC.ByteCode.Asm
+import GHC.ByteCode.Serialize
import GHC.ByteCode.Types
import GHC.Linker.Unit (getUnitDepends)
@@ -97,8 +98,9 @@ import GHC.Unit.Module.Graph
import GHC.Unit.Module.ModIface
import GHC.Unit.State as Packages
-import qualified GHC.Data.ShortText as ST
import GHC.Data.FastString
+import qualified GHC.Data.ShortText as ST
+import qualified GHC.Data.Strict as Strict
import GHC.Linker.Deps
import GHC.Linker.MacOS
@@ -136,7 +138,6 @@ import qualified GHC.Runtime.Interpreter as GHCi
import qualified Data.IntMap.Strict as IM
import qualified Data.Map.Strict as M
import Foreign.Ptr (nullPtr)
-import GHC.ByteCode.Serialize
-- Note [Linkers and loaders]
-- ~~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -1025,6 +1026,8 @@ dynLinkCompiledByteCode interp pkgs_loaded whole_bytecode_state traverse_bytecod
let ce2 = extendClosureEnv (closure_env (bco_linker_env bytecode_state)) new_binds
-- Add SPT entries
mapM_ (linkSptEntry interp ce2) (concatMap bc_spt_entries cbcs)
+ -- Load HPC modules
+ mapM_ (linkHpcEntry interp . bc_hpc_info) cbcs
return $! bytecode_state { bco_linker_env = (bco_linker_env bytecode_state) { closure_env = ce2 } }
-- | Register SPT entries for this module in the interpreter
@@ -1037,8 +1040,14 @@ linkSptEntry interp ce (SptEntry name fpr) = do
Nothing -> pprPanic "linkSptEntry" (ppr name)
Just (_, hval) -> addSptEntry interp fpr hval
-
-
+linkHpcEntry :: Interp -> Strict.Maybe ByteCodeHpcInfo -> IO ()
+linkHpcEntry _interp Strict.Nothing = pure ()
+linkHpcEntry interp (Strict.Just info) = do
+ addHpcModule interp
+ (bchi_module_name info)
+ (bchi_tick_count info)
+ (bchi_hash info)
+ (bchi_tickbox_name info)
-- Link a bunch of BCOs and return references to their values
linkSomeBCOs :: Interp
=====================================
compiler/GHC/Runtime/Interpreter.hs
=====================================
@@ -17,6 +17,7 @@ module GHC.Runtime.Interpreter
, mallocData
, createBCOs
, addSptEntry
+ , addHpcModule
, mkCostCentres
, costCentreStackInfo
, newBreakArray
@@ -366,6 +367,10 @@ addSptEntry interp fpr ref =
withForeignRef ref $ \val ->
interpCmd interp (AddSptEntry fpr val)
+addHpcModule :: Interp -> String -> Int -> Int -> String -> IO ()
+addHpcModule interp modLabel tickNo hash tickboxes =
+ interpCmd interp (AddHpcModule modLabel tickNo hash tickboxes)
+
costCentreStackInfo :: Interp -> RemotePtr CostCentreStack -> IO [String]
costCentreStackInfo interp ccs =
interpCmd interp (CostCentreStackInfo ccs)
=====================================
compiler/GHC/StgToByteCode.hs
=====================================
@@ -20,6 +20,7 @@ import GHC.ByteCode.Types
import GHC.Cmm.CallConv
import GHC.Cmm.Expr
+import GHC.Cmm.CLabel (mkHpcTicksLabel, pprCLabel)
import GHC.Cmm.Reg ( GlobalArgRegs(..) )
import GHC.Cmm.Node
import GHC.Cmm.Utils
@@ -97,6 +98,7 @@ import Control.Monad.IO.Class
import Control.Monad.Trans.Reader (ReaderT(..))
import Control.Monad.Trans.State (StateT(..))
import Data.Bifunctor (Bifunctor(..))
+import qualified GHC.Data.Strict as Strict
-- -----------------------------------------------------------------------------
-- Generating byte code for a complete module
@@ -107,8 +109,9 @@ byteCodeGen :: HscEnv
-> [TyCon]
-> Maybe ModBreaks
-> [SptEntry]
+ -> Strict.Maybe ByteCodeHpcInfo
-> IO CompiledByteCode
-byteCodeGen hsc_env this_mod binds tycs mb_modBreaks spt_entries
+byteCodeGen hsc_env this_mod binds tycs mb_modBreaks spt_entries hpc_info
= withTiming logger
(text "GHC.StgToByteCode"<+>brackets (ppr this_mod))
(const ()) $ do
@@ -134,7 +137,7 @@ byteCodeGen hsc_env this_mod binds tycs mb_modBreaks spt_entries
let mod_breaks = case mb_modBreaks of
Nothing -> Nothing
Just mb -> Just $ mkInternalModBreaks this_mod breakInfo mb
- cbc <- assembleBCOs profile proto_bcos tycs strings mod_breaks spt_entries
+ cbc <- assembleBCOs profile proto_bcos tycs strings mod_breaks spt_entries hpc_info
-- Squash space leaks in the CompiledByteCode. This is really
-- important, because when loading a set of modules into GHCi
@@ -604,6 +607,11 @@ schemeE _d _s _p (StgTick (Breakpoint _ bp_id _) _rhs)
= pprPanic "schemeE: Breakpoint without let binding:"
(ppr bp_id <+> text "forgot to run bcPrep?")
+schemeE d s p (StgTick (HpcTick mod ix) rhs) = do
+ platform <- profilePlatform <$> getProfile
+ rhs_code <- schemeE d s p rhs
+ pure (unitOL (HPC_TICK (mkHpcTickLabel platform mod) (fromIntegral ix)) `appOL` rhs_code)
+
-- ignore other kinds of tick
schemeE d s p (StgTick _ rhs) = schemeE d s p rhs
@@ -2784,6 +2792,10 @@ getLastBreakTick = BcM $ \env st ->
tickFS :: FastString
tickFS = fsLit "ticked"
+mkHpcTickLabel :: Platform -> Module -> FastString
+mkHpcTickLabel platform mod =
+ fsLit (showSDocOneLine defaultSDocContext (pprCLabel platform (mkHpcTicksLabel mod)))
+
-- Dehydrating CgBreakInfo
dehydrateCgBreakInfo :: [TyVar] -> [Maybe (Id, Word)] -> Type -> Either InternalBreakLoc BreakpointId -> CgBreakInfo
=====================================
compiler/GHC/Types/HpcInfo.hs
=====================================
@@ -18,4 +18,3 @@ data HpcInfo
emptyHpcInfo :: HpcInfo
emptyHpcInfo = NoHpcInfo
-
=====================================
compiler/GHC/Unit/Module/ModGuts.hs
=====================================
@@ -141,8 +141,9 @@ data CgGuts
cg_dep_pkgs :: !(Set UnitId), -- ^ Dependent packages, used to
-- generate #includes for C code gen
cg_modBreaks :: !(Maybe ModBreaks), -- ^ Module breakpoints
- cg_spt_entries :: [SptEntry]
+ cg_spt_entries :: [SptEntry],
-- ^ Static pointer table entries for static forms defined in
-- the module.
-- See Note [Grand plan for static forms] in "GHC.Iface.Tidy.StaticPtrTable"
+ cg_hpc_info :: HpcInfo
}
=====================================
libraries/ghci/GHCi/Coverage.hs
=====================================
@@ -0,0 +1,51 @@
+{-# LANGUAGE ForeignFunctionInterface #-}
+{-# LANGUAGE LambdaCase #-}
+
+module GHCi.Coverage (
+ hpcAddModule,
+ ) where
+
+import Prelude -- See note [Why do we import Prelude here?]
+
+import Control.Exception
+import qualified Data.ByteString.Char8 as BS8
+import qualified Data.ByteString.Unsafe as B
+import Data.Word
+import Foreign
+import Foreign.C.String (withCAString)
+import GHC.Fingerprint
+import GHC.Foreign (CString)
+import GHCi.ObjLink (lookupSymbol)
+
+-- | Inform the run-time system that the given module name is instrumented via @hpc@
+-- and to collect @.tix@ info.
+--
+-- Starts the `hpc` run-time if it hasn't already been started.
+hpcAddModule ::
+ String ->
+ -- ^ Name of the module to instrument
+ Int ->
+ -- ^ Number of hpc ticks in this module
+ Int ->
+ -- ^ 'HpcInfo's 'hpcInfoHash'
+ String ->
+ -- ^ Name of the ticks array found in the c-stub.
+ IO ()
+hpcAddModule modlName ticks hash tickboxes = do
+ withCAString modlName $ \modlNameLiteral -> do
+ -- we need to find the reference to the ticks array.
+ lookupSymbol tickboxes >>= \ case
+ Nothing -> do
+ -- the symbol is not found, this is a bug!
+ throwIO $ ErrorCall $ "hpcAddModule: failed to find symbol " <> tickboxes
+ Just tickBoxRef -> do
+ -- Calling 'hs_hpc_module' multiple times is safe, it will add the module only once.
+ hpc_register_module modlNameLiteral (fromIntegral ticks) (fromIntegral hash) (castPtr tickBoxRef)
+ -- calling 'hpc_startup' multiple times is safe, it will only be initialised once.
+ hpc_startup
+
+foreign import ccall "hs_hpc_module"
+ hpc_register_module :: CString -> Word32 -> Word32 -> Ptr Word64 -> IO ()
+
+foreign import ccall "startupHpc"
+ hpc_startup :: IO ()
=====================================
libraries/ghci/GHCi/Message.hs
=====================================
@@ -111,6 +111,8 @@ data Message a where
-- | Add entries to the Static Pointer Table
AddSptEntry :: Fingerprint -> HValueRef -> Message ()
+ -- | Add module to hpc
+ AddHpcModule :: String -> Int -> Int -> String -> Message ()
-- | Malloc some data and return a 'RemotePtr' to it
MallocData :: ByteString -> Message (RemotePtr ())
@@ -607,7 +609,8 @@ getMessage = do
38 -> Msg <$> (ResumeSeq <$> get)
39 -> Msg <$> (LookupSymbolInDLL <$> get <*> get)
40 -> Msg <$> (WhereFrom <$> get)
- 41 -> Msg <$> (CustomMessage <$> get <*> get)
+ 41 -> Msg <$> (AddHpcModule <$> get <*> get <*> get <*> get)
+ 42 -> Msg <$> (CustomMessage <$> get <*> get)
_ -> error $ "Unknown Message code " ++ (show b)
putMessage :: Message a -> Put
@@ -654,7 +657,8 @@ putMessage m = case m of
ResumeSeq a -> putWord8 38 >> put a
LookupSymbolInDLL dll str -> putWord8 39 >> put dll >> put str
WhereFrom a -> putWord8 40 >> put a
- CustomMessage tag payload -> putWord8 41 >> put tag >> put payload
+ AddHpcModule m n h ticks -> putWord8 41 >> put m >> put n >> put h >> put ticks
+ CustomMessage tag payload -> putWord8 42 >> put tag >> put payload
{-
Note [Parallelize CreateBCOs serialization]
=====================================
libraries/ghci/GHCi/Run.hs
=====================================
@@ -19,6 +19,7 @@ import GHCi.CreateBCO
import GHCi.InfoTable
#endif
+import GHCi.Coverage
import qualified GHC.InfoProv as InfoProv
import GHCi.Debugger
import GHCi.FFI
@@ -88,6 +89,7 @@ run m = case m of
fmap toRemotePtr <$> lookupSymbolInDLL (fromRemotePtr dll) str
FreeHValueRefs rs -> mapM_ freeRemoteRef rs
AddSptEntry fpr r -> localRef r >>= sptAddEntry fpr
+ AddHpcModule modl ticks hash tickboxes -> hpcAddModule modl ticks hash tickboxes
EvalStmt opts r -> evalStmt opts r
ResumeStmt opts r -> resumeStmt opts r
AbandonStmt r -> abandonStmt r
=====================================
libraries/ghci/ghci.cabal.in
=====================================
@@ -59,6 +59,7 @@ library
if flag(internal-interpreter)
CPP-Options: -DHAVE_INTERNAL_INTERPRETER
exposed-modules:
+ GHCi.Coverage
GHCi.Run
GHCi.Debugger
GHCi.CreateBCO
=====================================
rts/Disassembler.c
=====================================
@@ -101,6 +101,13 @@ disInstr ( StgBCO *bco, int pc )
}
debugBelch("\n");
break; }
+ case bci_HPC_TICK: {
+ W_ p1, info_wix;
+ p1 = BCO_GET_LARGE_ARG;
+ info_wix = BCO_READ_NEXT_32;
+ debugBelch("HPC_TICK "); printPtr((StgPtr)literals[p1]);
+ debugBelch(" %" FMT_Word "\n", info_wix);
+ break; }
case bci_SWIZZLE: {
W_ stkoff = BCO_GET_LARGE_ARG;
StgInt by = BCO_GET_LARGE_ARG;
=====================================
rts/Hpc.c
=====================================
@@ -270,6 +270,9 @@ hs_hpc_module(char *modName,
HpcModuleInfo *tmpModule;
uint32_t i;
+ debugTrace(DEBUG_hpc, "hs_hpc_module(%s, count=%u, hash=%u)\n",
+ modName, modCount, modHashNo);
+
if (moduleHash == NULL) {
moduleHash = allocStrHashTable();
}
=====================================
rts/Interpreter.c
=====================================
@@ -1711,7 +1711,7 @@ run_BCO:
&&lbl_bci_TESTEQ_W8 - &&lbl_bci_DEFAULT,
&&lbl_bci_PRIMCALL - &&lbl_bci_DEFAULT,
&&lbl_bci_BCO_NAME - &&lbl_bci_DEFAULT,
- &&lbl_bci_DEFAULT - &&lbl_bci_DEFAULT,
+ &&lbl_bci_HPC_TICK - &&lbl_bci_DEFAULT,
&&lbl_bci_OP_ADD_64 - &&lbl_bci_DEFAULT,
&&lbl_bci_OP_SUB_64 - &&lbl_bci_DEFAULT,
&&lbl_bci_OP_AND_64 - &&lbl_bci_DEFAULT,
@@ -2078,6 +2078,15 @@ run_BCO:
NEXT_INSTRUCTION;
}
+ INSTRUCTION(bci_HPC_TICK): {
+ W_ arg1_ticks_array, arg2_tick_index;
+ arg1_ticks_array = BCO_GET_LARGE_ARG;
+ arg2_tick_index = BCO_READ_NEXT_32;
+
+ ((StgWord64*)BCO_LIT(arg1_ticks_array))[arg2_tick_index]++;
+ NEXT_INSTRUCTION;
+ }
+
INSTRUCTION(bci_STKCHECK): {
// Explicit stack check at the beginning of a function
// *only* (stack checks in case alternatives are
=====================================
rts/include/rts/Bytecodes.h
=====================================
@@ -118,6 +118,7 @@
#define bci_PRIMCALL 87
#define bci_BCO_NAME 88
+#define bci_HPC_TICK 89
#define bci_OP_ADD_64 90
#define bci_OP_SUB_64 91
=====================================
testsuite/tests/hpc/ghc_ghci/BytecodeMain.hs
=====================================
@@ -0,0 +1,10 @@
+module Main where
+
+inc :: Int -> Int
+inc x = x + 1
+
+double :: Int -> Int
+double x = x * 2
+
+main :: IO ()
+main = print (double (inc 1011))
=====================================
testsuite/tests/hpc/ghc_ghci/Makefile
=====================================
@@ -7,3 +7,9 @@ hpc_ghc_ghci:
'$(TEST_HC)' $(TEST_HC_OPTS) -fhpc -c A.hs
echo b | '$(TEST_HC)' $(TEST_HC_OPTS_INTERACTIVE) B.hs
+hpc_ghc_ghci_bytecode:
+ rm -f ./*.tix
+ printf "main\n:quit\n" | '$(TEST_HC)' $(TEST_HC_OPTS_INTERACTIVE) -fhpc -fbyte-code-and-object-code -fprefer-byte-code BytecodeMain.hs
+ @[ -f .hpc/Main.mix ] || (echo "ERROR: Expected .hpc/Main.mix file not found"; exit 1)
+ @set -- ./*.tix; [ -f "$$1" ] || (echo "ERROR: Expected .tix file not found"; exit 1); '$(HPC)' report "$$1" Main > hpc-report.txt
+ @grep -F "100% expressions used" hpc-report.txt >/dev/null || (echo "ERROR: Expected full expression coverage in hpc report"; cat hpc-report.txt; exit 1)
=====================================
testsuite/tests/hpc/ghc_ghci/hpc_ghc_ghci_bytecode.stdout
=====================================
@@ -0,0 +1 @@
+2024
=====================================
testsuite/tests/hpc/ghc_ghci/test.T
=====================================
@@ -3,3 +3,8 @@ test('hpc_ghc_ghci',
[extra_files(['A.hs', 'B.hs']),
only_ways(['normal']), when(compiler_profiled(), skip), req_interp],
run_command, ['$MAKE -s --no-print-directory hpc_ghc_ghci'])
+
+test('hpc_ghc_ghci_bytecode',
+ [extra_files(['BytecodeMain.hs']),
+ only_ways(['normal']), when(compiler_profiled(), skip), req_interp],
+ run_command, ['$MAKE -s --no-print-directory hpc_ghc_ghci_bytecode'])
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/7af98e18d9e8078be9e876656950d92…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/7af98e18d9e8078be9e876656950d92…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/fendor/hpc-bc-support] Make HPC work with bytecode interpreter
by Hannes Siebenhandl (＠fendor) 02 Apr '26
by Hannes Siebenhandl (＠fendor) 02 Apr '26
02 Apr '26
Hannes Siebenhandl pushed to branch wip/fendor/hpc-bc-support at Glasgow Haskell Compiler / GHC
Commits:
2f87c2ad by fendor at 2026-04-02T11:21:17+02:00
Make HPC work with bytecode interpreter
Add support to generate .tix files from bytecode objects and the
bytecode interpreter.
Conceptually, we insert HPC ticks into the bytecode similar to how we insert
breakpoints.
HPC and breakpoints do not share the same tick array but we use a separate
tick-array for hpc/breakpoint ticks during bytecode generation.
We teach the bytecode interpreter to handle hpc ticks.
The implementation is quite trivial, simply increment the counter in the
global hpc_ticks array for the respective module.
This hpc_ticks array is generated as part of the `CStub`, so we can rely
on it existing.
A tricky bit is "registering" a bytecode object for HPC instrumentation.
In the compiled case, this is achieved via CStub and initializer/finalizers
`.init` sections which are called when the executable is run.
After the initializers have been invoked, which is before `hs_init_ghc`,
we then call `startup_hpc` in `hs_init_ghc` iff any modules were "registered"
for hpc instrumentation via `hs_hpc_module`.
Since bytecode objects are loaded after starting up GHCi, this workflow
doesn't work for supporting `hpc` and the `hpc` run-time is never
started, even if a module is added for instrumentation.
We fix this issue by employing the same technique as is for `SptEntry`s:
* We introduce a new field to `CompiledByteCode`, called `ByteCodeHpcInfo`
which contains enough information to call `hs_hpc_module`, allowing us to
register the module for `hpc` instrumentation`.
* After registering the module, we unconditionally call `startupHpc`, to make
sure the .tix file is written.
Calling `startupHpc` multiple times is safe.
Calling `hs_hpc_module` multiple times for the same module is also safe.
Evaluating a bytecode object instrumented with `-fhpc` without registering it
in the `hpc` run-time will simply not generate any `.tix` files for this
bytecode object.
Closes #27036
- - - - -
29 changed files:
- compiler/GHC/ByteCode/Asm.hs
- compiler/GHC/ByteCode/Binary.hs
- compiler/GHC/ByteCode/Instr.hs
- compiler/GHC/ByteCode/Types.hs
- compiler/GHC/Driver/Backend.hs
- compiler/GHC/Driver/CodeOutput.hs
- compiler/GHC/Driver/Main.hs
- compiler/GHC/Driver/Session.hs
- compiler/GHC/HsToCore.hs
- compiler/GHC/HsToCore/Coverage.hs
- compiler/GHC/HsToCore/Ticks.hs
- compiler/GHC/Iface/Tidy.hs
- compiler/GHC/Linker/Loader.hs
- compiler/GHC/Runtime/Interpreter.hs
- compiler/GHC/StgToByteCode.hs
- compiler/GHC/Types/HpcInfo.hs
- compiler/GHC/Unit/Module/ModGuts.hs
- + libraries/ghci/GHCi/Coverage.hs
- libraries/ghci/GHCi/Message.hs
- libraries/ghci/GHCi/Run.hs
- libraries/ghci/ghci.cabal.in
- rts/Disassembler.c
- rts/Hpc.c
- rts/Interpreter.c
- rts/include/rts/Bytecodes.h
- + testsuite/tests/hpc/ghc_ghci/BytecodeMain.hs
- testsuite/tests/hpc/ghc_ghci/Makefile
- + testsuite/tests/hpc/ghc_ghci/hpc_ghc_ghci_bytecode.stdout
- testsuite/tests/hpc/ghc_ghci/test.T
Changes:
=====================================
compiler/GHC/ByteCode/Asm.hs
=====================================
@@ -72,6 +72,7 @@ import GHC.Float (castFloatToWord32, castDoubleToWord64)
import qualified Data.List as List ( any )
import GHC.Exts
+import qualified GHC.Data.Strict as Strict
-- -----------------------------------------------------------------------------
@@ -111,8 +112,9 @@ assembleBCOs
-> [(Name, ByteString)]
-> Maybe InternalModBreaks
-> [SptEntry]
+ -> Strict.Maybe ByteCodeHpcInfo
-> IO CompiledByteCode
-assembleBCOs profile proto_bcos tycons top_strs modbreaks spt_entries = do
+assembleBCOs profile proto_bcos tycons top_strs modbreaks spt_entries use_hpc = do
-- TODO: the profile should be bundled with the interpreter: the rts ways are
-- fixed for an interpreter
let itbls = mkITbls profile tycons
@@ -123,6 +125,7 @@ assembleBCOs profile proto_bcos tycons top_strs modbreaks spt_entries = do
, bc_strs = top_strs
, bc_breaks = modbreaks
, bc_spt_entries = spt_entries
+ , bc_hpc_info = use_hpc
}
-- Note [Allocating string literals]
@@ -856,6 +859,12 @@ assembleI platform i = case i of
emit_ bci_BRK_FUN [ Op p1, Op info_addr, Op info_unitid_addr
, SmallOp ix_hi, SmallOp ix_lo, Op np ]
+ HPC_TICK lbl ix -> do
+ p <- lit1 (BCONPtrLbl lbl)
+ let ix_hi = fromIntegral (ix `shiftR` 16)
+ ix_lo = fromIntegral (ix .&. 0xffff)
+ emit_ bci_HPC_TICK [Op p, SmallOp ix_hi, SmallOp ix_lo]
+
#if MIN_VERSION_rts(1,0,3)
BCO_NAME name -> do np <- lit1 (BCONPtrStr name)
emit_ bci_BCO_NAME [Op np]
=====================================
compiler/GHC/ByteCode/Binary.hs
=====================================
@@ -135,13 +135,15 @@ instance Binary CompiledByteCode where
replicateM bc_strs_len $ (,) <$> getViaBinName bh <*> get bh
bc_breaks <- get bh
bc_spt_entries <- get bh
+ bc_hpc_info <- get bh
return $
CompiledByteCode
{ bc_bcos,
bc_itbls,
bc_strs,
bc_breaks,
- bc_spt_entries
+ bc_spt_entries,
+ bc_hpc_info
}
put_ bh CompiledByteCode {..} = do
@@ -154,6 +156,26 @@ instance Binary CompiledByteCode where
for_ bc_strs $ \(nm, str) -> putViaBinName bh nm *> put_ bh str
put_ bh bc_breaks
put_ bh bc_spt_entries
+ put_ bh bc_hpc_info
+
+instance Binary ByteCodeHpcInfo where
+ put_ bh ByteCodeHpcInfo{bchi_tick_count,bchi_hash,bchi_tickbox_name,bchi_module_name} = do
+ put_ bh bchi_module_name
+ put_ bh bchi_tickbox_name
+ put_ bh bchi_tick_count
+ put_ bh bchi_hash
+
+ get bh = do
+ bchi_module_name <- get bh
+ bchi_tickbox_name <- get bh
+ bchi_tick_count <- get bh
+ bchi_hash <- get bh
+ pure ByteCodeHpcInfo
+ { bchi_tick_count
+ , bchi_hash
+ , bchi_tickbox_name
+ , bchi_module_name
+ }
instance Binary UnlinkedBCO where
get bh =
=====================================
compiler/GHC/ByteCode/Instr.hs
=====================================
@@ -15,6 +15,7 @@ import GHC.ByteCode.Types
import GHC.Cmm.Type (Width)
import GHC.StgToCmm.Layout ( ArgRep(..) )
import GHC.Utils.Outputable
+import GHC.Data.FastString ( FastString )
import GHC.Types.Name
import GHC.Types.Literal
import GHC.Types.Unique
@@ -257,6 +258,7 @@ data BCInstr
-- Breakpoints
| BRK_FUN !InternalBreakpointId
+ | HPC_TICK !FastString !Word32
#if MIN_VERSION_rts(1,0,3)
-- | A "meta"-instruction for recording the name of a BCO for debugging purposes.
@@ -452,6 +454,7 @@ instance Outputable BCInstr where
= text "BRK_FUN" <+> text "<breakarray>"
<+> ppr info_mod <+> ppr infox
<+> text "<cc>"
+ ppr (HPC_TICK lbl ix) = text "HPC_TICK" <+> ppr lbl <+> ppr ix
#if MIN_VERSION_rts(1,0,3)
ppr (BCO_NAME nm) = text "BCO_NAME" <+> text (show nm)
#endif
@@ -578,6 +581,7 @@ bciStackUse OP_INDEX_ADDR{} = 0
bciStackUse SWIZZLE{} = 0
bciStackUse BRK_FUN{} = 0
+bciStackUse HPC_TICK{} = 0
-- These insns actually reduce stack use, but we need the high-tide level,
-- so can't use this info. Not that it matters much.
=====================================
compiler/GHC/ByteCode/Types.hs
=====================================
@@ -25,6 +25,9 @@ module GHC.ByteCode.Types
-- * Mod Breaks
, ModBreaks (..), BreakpointId(..), BreakTickIndex
+ -- * Hpc Info
+ , ByteCodeHpcInfo(..)
+
-- * Internal Mod Breaks
, InternalModBreaks(..), CgBreakInfo(..), seqInternalModBreaks
-- ** Internal breakpoint identifier
@@ -35,6 +38,7 @@ import GHC.Prelude
import GHC.Data.FastString
import GHC.Data.FlatBag
+import qualified GHC.Data.Strict as Strict
import GHC.Types.Name
import GHC.Types.Name.Env
import GHC.Utils.Binary
@@ -79,6 +83,25 @@ data CompiledByteCode = CompiledByteCode
-- ^ Static pointer table entries which should be loaded along with the
-- BCOs. See Note [Grand plan for static forms] in
-- "GHC.Iface.Tidy.StaticPtrTable".
+
+ , bc_hpc_info :: !(Strict.Maybe ByteCodeHpcInfo)
+ -- ^ 'ByteCodeHpcInfo' that should be added to the run-time system when this 'CompiledByteCode'
+ -- object is loaded.
+ --
+ -- It is safe to load the same 'ByteCodeHpcInfo' multiple times.
+ }
+
+-- | ByteCode specific HPC information.
+--
+data ByteCodeHpcInfo = ByteCodeHpcInfo
+ { bchi_module_name :: !String
+ -- ^ Name of the module.
+ , bchi_tickbox_name :: !String
+ -- ^ Name of the tick box that has been added via 'CStub'.
+ , bchi_tick_count :: {-# UNPACK #-} !Int
+ -- ^ Number of ticks.
+ , bchi_hash :: {-# UNPACK #-} !Int
+ -- ^ mix-file hash.
}
-- | A libffi ffi_cif function prototype.
=====================================
compiler/GHC/Driver/Backend.hs
=====================================
@@ -712,8 +712,7 @@ backendSupportsHpc (Named NCG) = True
backendSupportsHpc (Named LLVM) = True
backendSupportsHpc (Named ViaC) = True
backendSupportsHpc (Named JavaScript) = False
--- TODO: @terrorjack thinks that the bytecode backend should support HPC now since (!13493)
-backendSupportsHpc (Named Bytecode) = False
+backendSupportsHpc (Named Bytecode) = True
backendSupportsHpc (Named NoBackend) = True
-- | This flag says whether the back end supports foreign
=====================================
compiler/GHC/Driver/CodeOutput.hs
=====================================
@@ -343,7 +343,6 @@ outputForeignStubs logger tmpfs dflags unit_state mod location stubs
cplusplus_hdr = "#if defined(__cplusplus)\nextern \"C\" {\n#endif\n"
cplusplus_ftr = "#if defined(__cplusplus)\n}\n#endif\n"
-
-- It is more than likely that the stubs file will
-- turn out to be empty, in which case no file should be created.
outputForeignStubs_help :: FilePath -> String -> String -> String -> IO Bool
=====================================
compiler/GHC/Driver/Main.hs
=====================================
@@ -134,6 +134,7 @@ import GHC.Driver.Config.Diagnostic
import GHC.Driver.Config.Tidy
import GHC.Driver.Hooks
import GHC.Driver.GenerateCgIPEStub (generateCgIPEStub, lookupEstimatedTicks)
+import GHC.Driver.Ppr (showSDoc)
import GHC.Runtime.Context
import GHC.Runtime.Interpreter
@@ -151,6 +152,7 @@ import GHC.Hs.Dump
import GHC.Hs.Stats ( ppSourceStats )
import GHC.HsToCore
+import GHC.HsToCore.Coverage ( hpcTickBoxes, hpcModuleName )
import GHC.StgToByteCode ( byteCodeGen )
import GHC.StgToJS ( stgToJS )
@@ -207,6 +209,8 @@ import qualified GHC.StgToCmm as StgToCmm ( codeGen )
import GHC.StgToCmm.Types (CmmCgInfos (..), ModuleLFInfos, LambdaFormInfo(..))
import GHC.StgToCmm.CgUtils (CgStream)
+import qualified GHC.ByteCode.Serialize as ByteCode
+
import GHC.Cmm
import GHC.Cmm.Info.Build
import GHC.Cmm.Pipeline
@@ -237,6 +241,7 @@ import GHC.Types.Var.Set
import GHC.Types.Error
import GHC.Types.Fixity.Env
import GHC.Types.CostCentre
+import GHC.Types.HpcInfo (HpcInfo (..))
import GHC.Types.IPE
import GHC.Types.SourceFile
import GHC.Types.SrcLoc
@@ -260,6 +265,7 @@ import GHC.Utils.Touch
import GHC.Data.FastString
import GHC.Data.Bag
import GHC.Data.OsPath (unsafeEncodeUtf)
+import qualified GHC.Data.Strict as Strict
import GHC.Data.StringBuffer
import qualified GHC.Data.Stream as Stream
import GHC.Data.Maybe
@@ -297,7 +303,6 @@ import GHC.Cmm.Config (CmmConfig)
import Data.Bifunctor
import qualified GHC.Unit.Home.Graph as HUG
import GHC.Unit.Home.PackageTable
-import qualified GHC.ByteCode.Serialize as ByteCode
{- **********************************************************************
%* *
@@ -1185,7 +1190,7 @@ compileWholeCoreBindings hsc_env type_env wcb = do
gen_bytecode core_binds stubs foreign_files = do
let cgi_guts = CgInteractiveGuts wcb_module core_binds
(typeEnvTyCons type_env) stubs foreign_files
- Nothing []
+ Nothing [] NoHpcInfo
trace_if logger (text "Generating ByteCode for" <+> ppr wcb_module)
mkModuleByteCode hsc_env wcb_module wcb_mod_location cgi_guts
@@ -2135,11 +2140,12 @@ data CgInteractiveGuts = CgInteractiveGuts { cgi_module :: Module
, cgi_foreign_files :: [(ForeignSrcLang, FilePath)]
, cgi_modBreaks :: Maybe ModBreaks
, cgi_spt_entries :: [SptEntry]
+ , cgi_hpc_info :: HpcInfo
}
mkCgInteractiveGuts :: CgGuts -> CgInteractiveGuts
-mkCgInteractiveGuts CgGuts{cg_module, cg_binds, cg_tycons, cg_foreign, cg_foreign_files, cg_modBreaks, cg_spt_entries}
- = CgInteractiveGuts cg_module cg_binds cg_tycons cg_foreign cg_foreign_files cg_modBreaks cg_spt_entries
+mkCgInteractiveGuts CgGuts{cg_module, cg_binds, cg_tycons, cg_foreign, cg_foreign_files, cg_modBreaks, cg_spt_entries, cg_hpc_info}
+ = CgInteractiveGuts cg_module cg_binds cg_tycons cg_foreign cg_foreign_files cg_modBreaks cg_spt_entries cg_hpc_info
hscInteractive :: HscEnv
-> CgInteractiveGuts
@@ -2162,13 +2168,15 @@ hscGenerateByteCode :: HscEnv -> CgInteractiveGuts -> ModLocation -> IO Compiled
hscGenerateByteCode hsc_env cgguts location = do
let dflags = hsc_dflags hsc_env
let logger = hsc_logger hsc_env
+ let platform = targetPlatform dflags
let CgInteractiveGuts{ -- This is the last use of the ModGuts in a compilation.
-- From now on, we just use the bits we need.
cgi_module = this_mod,
cgi_binds = core_binds,
cgi_tycons = tycons,
cgi_modBreaks = mod_breaks,
- cgi_spt_entries = spt_entries } = cgguts
+ cgi_spt_entries = spt_entries,
+ cgi_hpc_info = hpc_info } = cgguts
-------------------
-- ADD IMPLICIT BINDINGS
@@ -2193,8 +2201,22 @@ hscGenerateByteCode hsc_env cgguts location = do
let (stg_binds,_stg_deps) = unzip stg_binds_with_deps
+ -------------------
+ -- Setup HPC info
+ let
+ -- Strict to not retain a reference to the 'cgguts' via 'hpc_info'
+ !bytecodeHpcInfo = case hpc_info of
+ NoHpcInfo -> Strict.Nothing
+ HpcInfo{hpcInfoTickCount, hpcInfoHash} ->
+ Strict.Just ByteCodeHpcInfo
+ { bchi_tick_count = hpcInfoTickCount
+ , bchi_hash = hpcInfoHash
+ , bchi_tickboxes = showSDoc dflags $ hpcTickBoxes platform this_mod
+ , bchi_module_name = showSDoc dflags $ hpcModuleName this_mod
+ }
+
----------------- Generate byte code ------------------
- byteCodeGen hsc_env this_mod stg_binds tycons mod_breaks spt_entries
+ byteCodeGen hsc_env this_mod stg_binds tycons mod_breaks spt_entries bytecodeHpcInfo
-- | Generate a byte code object linkable and write it to a file if `-fwrite-byte-code` is enabled.
generateAndWriteByteCode :: HscEnv -> CgInteractiveGuts -> ModLocation -> IO ModuleByteCode
@@ -2843,6 +2865,7 @@ hscCompileCoreExpr' hsc_env srcspan ds_expr = do
[]
Nothing -- modbreaks
[] -- spt entries
+ Strict.Nothing -- no hpc info
{- load it -}
bco_time <- getCurrentTime
=====================================
compiler/GHC/Driver/Session.hs
=====================================
@@ -3791,12 +3791,6 @@ makeDynFlagsConsistent dflags
pgmError (backendDescription (backend dflags) ++
" supports only unregisterised ABI but target platform doesn't use it.")
- | gopt Opt_Hpc dflags && not (backendSupportsHpc (backend dflags))
- = let dflags' = gopt_unset dflags Opt_Hpc
- warn = "Hpc can't be used with " ++ backendDescription (backend dflags) ++
- ". Ignoring -fhpc."
- in loop dflags' warn
-
| backendSwappableWithViaC (backend dflags) &&
platformUnregisterised (targetPlatform dflags)
= loop (dflags { backend = viaCBackend })
=====================================
compiler/GHC/HsToCore.hs
=====================================
@@ -163,20 +163,20 @@ deSugar hsc_env
export_set (typeEnvTyCons type_env) binds
else return (binds, Nothing)
; let modBreaks
- | Just (_, specs) <- m_tickInfo
+ | Just (_, _, breakpointSpecs) <- m_tickInfo
, breakpointsAllowed dflags
- = Just $ mkModBreaks (interpreterProfiled $ hscInterp hsc_env) mod specs
+ = Just $ mkModBreaks (interpreterProfiled $ hscInterp hsc_env) mod breakpointSpecs
| otherwise
= Nothing
; ds_hpc_info <- case m_tickInfo of
- Just (orig_file2, ticks)
+ Just (orig_file2, hpcTicks, _)
| gopt Opt_Hpc $ hsc_dflags hsc_env
-> do
hashNo <- if gopt Opt_Hpc $ hsc_dflags hsc_env
- then writeMixEntries (hpcDir dflags) mod ticks orig_file2
+ then writeMixEntries (hpcDir dflags) mod hpcTicks orig_file2
else return 0 -- dummy hash when none are written
- pure $ HpcInfo (fromIntegral $ sizeSS ticks) hashNo
+ pure $ HpcInfo (fromIntegral $ sizeSS hpcTicks) hashNo
_ -> pure $ emptyHpcInfo
; (msgs, mb_res) <- initDs hsc_env tcg_env $
=====================================
compiler/GHC/HsToCore/Coverage.hs
=====================================
@@ -6,6 +6,9 @@
module GHC.HsToCore.Coverage
( writeMixEntries
, hpcInitCode
+ , hpcStubLabel
+ , hpcModuleName
+ , hpcTickBoxes
) where
import GHC.Prelude as Prelude
@@ -116,24 +119,33 @@ hpcInitCode _ _ (NoHpcInfo {}) = mempty
hpcInitCode platform this_mod (HpcInfo tickCount hashNo)
= initializerCStub platform fn_name decls body
where
- fn_name = mkInitializerStubLabel this_mod (fsLit "hpc")
+ fn_name = hpcStubLabel this_mod
decls = text "StgWord64 " <> tickboxes <> brackets (int tickCount) <> semi
body = text "hs_hpc_module" <>
parens (hcat (punctuate comma [
- doubleQuotes full_name_str,
+ doubleQuotes (hpcModuleName this_mod),
int tickCount, -- really StgWord32
int hashNo, -- really StgWord32
tickboxes
])) <> semi
+ tickboxes = hpcTickBoxes platform this_mod
- tickboxes = pprCLabel platform (mkHpcTicksLabel $ this_mod)
-
- module_name = hcat (map (text.charToC) $ BS.unpack $
- bytesFS (moduleNameFS (moduleName this_mod)))
- package_name = hcat (map (text.charToC) $ BS.unpack $
- bytesFS (unitFS (moduleUnit this_mod)))
- full_name_str
- | moduleUnit this_mod == mainUnit
- = module_name
- | otherwise
- = package_name <> char '/' <> module_name
+hpcStubLabel :: Module -> CLabel
+hpcStubLabel this_mod = mkInitializerStubLabel this_mod (fsLit "hpc")
+
+hpcModuleName :: Module -> SDoc
+hpcModuleName this_mod = full_name_str
+ where
+ full_name_str
+ | moduleUnit this_mod == mainUnit
+ = module_name
+ | otherwise
+ = package_name <> char '/' <> module_name
+ module_name = hcat (map (text.charToC) $ BS.unpack $
+ bytesFS (moduleNameFS (moduleName this_mod)))
+
+ package_name = hcat (map (text.charToC) $ BS.unpack $
+ bytesFS (unitFS (moduleUnit this_mod)))
+
+hpcTickBoxes :: Platform -> Module -> SDoc
+hpcTickBoxes platform this_mod = pprCLabel platform (mkHpcTicksLabel this_mod)
=====================================
compiler/GHC/HsToCore/Ticks.hs
=====================================
@@ -100,7 +100,7 @@ addTicksToBinds
-- hasn't set it), so we have to work from this set.
-> [TyCon] -- ^ Type constructors in this module
-> LHsBinds GhcTc
- -> IO (LHsBinds GhcTc, Maybe (FilePath, SizedSeq Tick))
+ -> IO (LHsBinds GhcTc, Maybe (FilePath, SizedSeq Tick, SizedSeq Tick))
addTicksToBinds logger cfg
mod mod_loc exports tyCons binds
@@ -133,12 +133,13 @@ addTicksToBinds logger cfg
(binds1,st) = foldr tickPass (binds, initTTState) passes
- extendedMixEntries = ticks st
+ hpcEntries = hpcTicks st
+ breakpointEntries = breakpointTicks st
putDumpFileMaybe logger Opt_D_dump_ticked "HPC" FormatHaskell
(pprLHsBinds binds1)
- return (binds1, Just (orig_file2, extendedMixEntries))
+ return (binds1, Just (orig_file2, hpcEntries, breakpointEntries))
| otherwise = return (binds, Nothing)
@@ -1050,23 +1051,31 @@ addTickArithSeqInfo (FromThenTo e1 e2 e3) =
(addTickLHsExpr e2)
(addTickLHsExpr e3)
-data TickTransState = TT { ticks :: !(SizedSeq Tick)
- , ccIndices :: !CostCentreState
- , recSelTicks :: !(IdEnv CoreTickish)
+data TickTransState = TT { hpcTicks :: !(SizedSeq Tick)
+ , breakpointTicks :: !(SizedSeq Tick)
+ , ccIndices :: !CostCentreState
+ , recSelTicks :: !(IdEnv CoreTickish)
}
initTTState :: TickTransState
-initTTState = TT { ticks = emptySS
- , ccIndices = newCostCentreState
- , recSelTicks = emptyVarEnv
+initTTState = TT { hpcTicks = emptySS
+ , breakpointTicks = emptySS
+ , ccIndices = newCostCentreState
+ , recSelTicks = emptyVarEnv
}
-addMixEntry :: Tick -> TM Int
-addMixEntry ent = do
- c <- fromIntegral . sizeSS . ticks <$> getState
+addHpcEntry :: Tick -> TM Int
+addHpcEntry ent = do
+ c <- fromIntegral . sizeSS . hpcTicks <$> getState
setState $ \st ->
- st { ticks = addToSS (ticks st) ent
- }
+ st { hpcTicks = addToSS (hpcTicks st) ent }
+ return c
+
+addBreakpointEntry :: Tick -> TM Int
+addBreakpointEntry ent = do
+ c <- fromIntegral . sizeSS . breakpointTicks <$> getState
+ setState $ \st ->
+ st { breakpointTicks = addToSS (breakpointTicks st) ent }
return c
addRecSelTick :: Id -> CoreTickish -> TM ()
@@ -1291,7 +1300,7 @@ mkTickish boxLabel countEntries topOnly pos fvs decl_path = do
env <- getEnv
case tickishType env of
- HpcTicks -> HpcTick (this_mod env) <$> addMixEntry me
+ HpcTicks -> HpcTick (this_mod env) <$> addHpcEntry me
ProfNotes -> do
flavour <- mkHpcCCFlavour <$> getCCIndexM cc_name
@@ -1300,7 +1309,7 @@ mkTickish boxLabel countEntries topOnly pos fvs decl_path = do
return $ ProfNote cc count True{-scopes-}
Breakpoints -> do
- i <- addMixEntry me
+ i <- addBreakpointEntry me
pure (Breakpoint noExtField (BreakpointId (this_mod env) i) ids)
SourceNotes | RealSrcSpan pos' _ <- pos ->
@@ -1325,19 +1334,19 @@ mkBinTickBoxHpc :: (Bool -> BoxLabel) -> SrcSpan -> LHsExpr GhcTc
mkBinTickBoxHpc boxLabel pos e = do
env <- getEnv
binTick <- HsBinTick
- <$> addMixEntry (Tick { tick_loc = pos
+ <$> addHpcEntry (Tick { tick_loc = pos
, tick_path = declPath env
, tick_ids = []
, tick_label = boxLabel True
})
- <*> addMixEntry (Tick { tick_loc = pos
+ <*> addHpcEntry (Tick { tick_loc = pos
, tick_path = declPath env
, tick_ids = []
, tick_label = boxLabel False
})
<*> pure e
tick <- HpcTick (this_mod env)
- <$> addMixEntry (Tick { tick_loc = pos
+ <$> addHpcEntry (Tick { tick_loc = pos
, tick_path = declPath env
, tick_ids = []
, tick_label = ExpBox False
=====================================
compiler/GHC/Iface/Tidy.hs
=====================================
@@ -402,6 +402,7 @@ tidyProgram opts (ModGuts { mg_module = mod
, mg_foreign_files = foreign_files
, mg_modBreaks = modBreaks
, mg_boot_exports = boot_exports
+ , mg_hpc_info = hpc_info
}) = do
(unfold_env, tidy_occ_env) <- chooseExternalIds opts mod tcs binds imp_rules
@@ -471,6 +472,7 @@ tidyProgram opts (ModGuts { mg_module = mod
, cg_dep_pkgs = S.map snd (dep_direct_pkgs deps)
, cg_modBreaks = modBreaks
, cg_spt_entries = spt_entries
+ , cg_hpc_info = hpc_info
}
, ModDetails { md_types = tidy_type_env
, md_rules = tidy_rules
=====================================
compiler/GHC/Linker/Loader.hs
=====================================
@@ -65,9 +65,10 @@ import GHCi.RemoteTypes
import GHC.Iface.Load
import GHCi.Message
+import GHC.ByteCode.Asm
import GHC.ByteCode.Breakpoints
import GHC.ByteCode.Linker
-import GHC.ByteCode.Asm
+import GHC.ByteCode.Serialize
import GHC.ByteCode.Types
import GHC.Linker.Unit (getUnitDepends)
@@ -97,8 +98,9 @@ import GHC.Unit.Module.Graph
import GHC.Unit.Module.ModIface
import GHC.Unit.State as Packages
-import qualified GHC.Data.ShortText as ST
import GHC.Data.FastString
+import qualified GHC.Data.ShortText as ST
+import qualified GHC.Data.Strict as Strict
import GHC.Linker.Deps
import GHC.Linker.MacOS
@@ -136,7 +138,6 @@ import qualified GHC.Runtime.Interpreter as GHCi
import qualified Data.IntMap.Strict as IM
import qualified Data.Map.Strict as M
import Foreign.Ptr (nullPtr)
-import GHC.ByteCode.Serialize
-- Note [Linkers and loaders]
-- ~~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -1025,6 +1026,8 @@ dynLinkCompiledByteCode interp pkgs_loaded whole_bytecode_state traverse_bytecod
let ce2 = extendClosureEnv (closure_env (bco_linker_env bytecode_state)) new_binds
-- Add SPT entries
mapM_ (linkSptEntry interp ce2) (concatMap bc_spt_entries cbcs)
+ -- Load HPC modules
+ mapM_ (linkHpcEntry interp . bc_hpc_info) cbcs
return $! bytecode_state { bco_linker_env = (bco_linker_env bytecode_state) { closure_env = ce2 } }
-- | Register SPT entries for this module in the interpreter
@@ -1037,8 +1040,14 @@ linkSptEntry interp ce (SptEntry name fpr) = do
Nothing -> pprPanic "linkSptEntry" (ppr name)
Just (_, hval) -> addSptEntry interp fpr hval
-
-
+linkHpcEntry :: Interp -> Strict.Maybe ByteCodeHpcInfo -> IO ()
+linkHpcEntry _interp Strict.Nothing = pure ()
+linkHpcEntry interp (Strict.Just info) = do
+ addHpcModule interp
+ (bchi_module_name info)
+ (bchi_tick_count info)
+ (bchi_hash info)
+ (bchi_tickbox_name info)
-- Link a bunch of BCOs and return references to their values
linkSomeBCOs :: Interp
=====================================
compiler/GHC/Runtime/Interpreter.hs
=====================================
@@ -17,6 +17,7 @@ module GHC.Runtime.Interpreter
, mallocData
, createBCOs
, addSptEntry
+ , addHpcModule
, mkCostCentres
, costCentreStackInfo
, newBreakArray
@@ -366,6 +367,10 @@ addSptEntry interp fpr ref =
withForeignRef ref $ \val ->
interpCmd interp (AddSptEntry fpr val)
+addHpcModule :: Interp -> String -> Int -> Int -> String -> IO ()
+addHpcModule interp modLabel tickNo hash tickboxes =
+ interpCmd interp (AddHpcModule modLabel tickNo hash tickboxes)
+
costCentreStackInfo :: Interp -> RemotePtr CostCentreStack -> IO [String]
costCentreStackInfo interp ccs =
interpCmd interp (CostCentreStackInfo ccs)
=====================================
compiler/GHC/StgToByteCode.hs
=====================================
@@ -20,6 +20,7 @@ import GHC.ByteCode.Types
import GHC.Cmm.CallConv
import GHC.Cmm.Expr
+import GHC.Cmm.CLabel (mkHpcTicksLabel, pprCLabel)
import GHC.Cmm.Reg ( GlobalArgRegs(..) )
import GHC.Cmm.Node
import GHC.Cmm.Utils
@@ -97,6 +98,7 @@ import Control.Monad.IO.Class
import Control.Monad.Trans.Reader (ReaderT(..))
import Control.Monad.Trans.State (StateT(..))
import Data.Bifunctor (Bifunctor(..))
+import qualified GHC.Data.Strict as Strict
-- -----------------------------------------------------------------------------
-- Generating byte code for a complete module
@@ -107,8 +109,9 @@ byteCodeGen :: HscEnv
-> [TyCon]
-> Maybe ModBreaks
-> [SptEntry]
+ -> Strict.Maybe ByteCodeHpcInfo
-> IO CompiledByteCode
-byteCodeGen hsc_env this_mod binds tycs mb_modBreaks spt_entries
+byteCodeGen hsc_env this_mod binds tycs mb_modBreaks spt_entries hpc_info
= withTiming logger
(text "GHC.StgToByteCode"<+>brackets (ppr this_mod))
(const ()) $ do
@@ -134,7 +137,7 @@ byteCodeGen hsc_env this_mod binds tycs mb_modBreaks spt_entries
let mod_breaks = case mb_modBreaks of
Nothing -> Nothing
Just mb -> Just $ mkInternalModBreaks this_mod breakInfo mb
- cbc <- assembleBCOs profile proto_bcos tycs strings mod_breaks spt_entries
+ cbc <- assembleBCOs profile proto_bcos tycs strings mod_breaks spt_entries hpc_info
-- Squash space leaks in the CompiledByteCode. This is really
-- important, because when loading a set of modules into GHCi
@@ -604,6 +607,11 @@ schemeE _d _s _p (StgTick (Breakpoint _ bp_id _) _rhs)
= pprPanic "schemeE: Breakpoint without let binding:"
(ppr bp_id <+> text "forgot to run bcPrep?")
+schemeE d s p (StgTick (HpcTick mod ix) rhs) = do
+ platform <- profilePlatform <$> getProfile
+ rhs_code <- schemeE d s p rhs
+ pure (unitOL (HPC_TICK (mkHpcTickLabel platform mod) (fromIntegral ix)) `appOL` rhs_code)
+
-- ignore other kinds of tick
schemeE d s p (StgTick _ rhs) = schemeE d s p rhs
@@ -2784,6 +2792,10 @@ getLastBreakTick = BcM $ \env st ->
tickFS :: FastString
tickFS = fsLit "ticked"
+mkHpcTickLabel :: Platform -> Module -> FastString
+mkHpcTickLabel platform mod =
+ fsLit (showSDocOneLine defaultSDocContext (pprCLabel platform (mkHpcTicksLabel mod)))
+
-- Dehydrating CgBreakInfo
dehydrateCgBreakInfo :: [TyVar] -> [Maybe (Id, Word)] -> Type -> Either InternalBreakLoc BreakpointId -> CgBreakInfo
=====================================
compiler/GHC/Types/HpcInfo.hs
=====================================
@@ -18,4 +18,3 @@ data HpcInfo
emptyHpcInfo :: HpcInfo
emptyHpcInfo = NoHpcInfo
-
=====================================
compiler/GHC/Unit/Module/ModGuts.hs
=====================================
@@ -141,8 +141,9 @@ data CgGuts
cg_dep_pkgs :: !(Set UnitId), -- ^ Dependent packages, used to
-- generate #includes for C code gen
cg_modBreaks :: !(Maybe ModBreaks), -- ^ Module breakpoints
- cg_spt_entries :: [SptEntry]
+ cg_spt_entries :: [SptEntry],
-- ^ Static pointer table entries for static forms defined in
-- the module.
-- See Note [Grand plan for static forms] in "GHC.Iface.Tidy.StaticPtrTable"
+ cg_hpc_info :: HpcInfo
}
=====================================
libraries/ghci/GHCi/Coverage.hs
=====================================
@@ -0,0 +1,51 @@
+{-# LANGUAGE ForeignFunctionInterface #-}
+{-# LANGUAGE LambdaCase #-}
+
+module GHCi.Coverage (
+ hpcAddModule,
+ ) where
+
+import Prelude -- See note [Why do we import Prelude here?]
+
+import Control.Exception
+import qualified Data.ByteString.Char8 as BS8
+import qualified Data.ByteString.Unsafe as B
+import Data.Word
+import Foreign
+import Foreign.C.String (withCAString)
+import GHC.Fingerprint
+import GHC.Foreign (CString)
+import GHCi.ObjLink (lookupSymbol)
+
+-- | Inform the run-time system that the given module name is instrumented via @hpc@
+-- and to collect @.tix@ info.
+--
+-- Starts the `hpc` run-time if it hasn't already been started.
+hpcAddModule ::
+ String ->
+ -- ^ Name of the module to instrument
+ Int ->
+ -- ^ Number of hpc ticks in this module
+ Int ->
+ -- ^ 'HpcInfo's 'hpcInfoHash'
+ String ->
+ -- ^ Name of the ticks array found in the c-stub.
+ IO ()
+hpcAddModule modlName ticks hash tickboxes = do
+ withCAString modlName $ \modlNameLiteral -> do
+ -- we need to find the reference to the ticks array.
+ lookupSymbol tickboxes >>= \ case
+ Nothing -> do
+ -- the symbol is not found, this is a bug!
+ throwIO $ ErrorCall $ "hpcAddModule: failed to find symbol " <> tickboxes
+ Just tickBoxRef -> do
+ -- Calling 'hs_hpc_module' multiple times is safe, it will add the module only once.
+ hpc_register_module modlNameLiteral (fromIntegral ticks) (fromIntegral hash) (castPtr tickBoxRef)
+ -- calling 'hpc_startup' multiple times is safe, it will only be initialised once.
+ hpc_startup
+
+foreign import ccall "hs_hpc_module"
+ hpc_register_module :: CString -> Word32 -> Word32 -> Ptr Word64 -> IO ()
+
+foreign import ccall "startupHpc"
+ hpc_startup :: IO ()
=====================================
libraries/ghci/GHCi/Message.hs
=====================================
@@ -111,6 +111,8 @@ data Message a where
-- | Add entries to the Static Pointer Table
AddSptEntry :: Fingerprint -> HValueRef -> Message ()
+ -- | Add module to hpc
+ AddHpcModule :: String -> Int -> Int -> String -> Message ()
-- | Malloc some data and return a 'RemotePtr' to it
MallocData :: ByteString -> Message (RemotePtr ())
@@ -607,7 +609,8 @@ getMessage = do
38 -> Msg <$> (ResumeSeq <$> get)
39 -> Msg <$> (LookupSymbolInDLL <$> get <*> get)
40 -> Msg <$> (WhereFrom <$> get)
- 41 -> Msg <$> (CustomMessage <$> get <*> get)
+ 41 -> Msg <$> (AddHpcModule <$> get <*> get <*> get <*> get)
+ 42 -> Msg <$> (CustomMessage <$> get <*> get)
_ -> error $ "Unknown Message code " ++ (show b)
putMessage :: Message a -> Put
@@ -654,7 +657,8 @@ putMessage m = case m of
ResumeSeq a -> putWord8 38 >> put a
LookupSymbolInDLL dll str -> putWord8 39 >> put dll >> put str
WhereFrom a -> putWord8 40 >> put a
- CustomMessage tag payload -> putWord8 41 >> put tag >> put payload
+ AddHpcModule m n h ticks -> putWord8 41 >> put m >> put n >> put h >> put ticks
+ CustomMessage tag payload -> putWord8 42 >> put tag >> put payload
{-
Note [Parallelize CreateBCOs serialization]
=====================================
libraries/ghci/GHCi/Run.hs
=====================================
@@ -19,6 +19,7 @@ import GHCi.CreateBCO
import GHCi.InfoTable
#endif
+import GHCi.Coverage
import qualified GHC.InfoProv as InfoProv
import GHCi.Debugger
import GHCi.FFI
@@ -88,6 +89,7 @@ run m = case m of
fmap toRemotePtr <$> lookupSymbolInDLL (fromRemotePtr dll) str
FreeHValueRefs rs -> mapM_ freeRemoteRef rs
AddSptEntry fpr r -> localRef r >>= sptAddEntry fpr
+ AddHpcModule modl ticks hash tickboxes -> hpcAddModule modl ticks hash tickboxes
EvalStmt opts r -> evalStmt opts r
ResumeStmt opts r -> resumeStmt opts r
AbandonStmt r -> abandonStmt r
=====================================
libraries/ghci/ghci.cabal.in
=====================================
@@ -59,6 +59,7 @@ library
if flag(internal-interpreter)
CPP-Options: -DHAVE_INTERNAL_INTERPRETER
exposed-modules:
+ GHCi.Coverage
GHCi.Run
GHCi.Debugger
GHCi.CreateBCO
=====================================
rts/Disassembler.c
=====================================
@@ -101,6 +101,13 @@ disInstr ( StgBCO *bco, int pc )
}
debugBelch("\n");
break; }
+ case bci_HPC_TICK: {
+ W_ p1, info_wix;
+ p1 = BCO_GET_LARGE_ARG;
+ info_wix = BCO_READ_NEXT_32;
+ debugBelch("HPC_TICK "); printPtr((StgPtr)literals[p1]);
+ debugBelch(" %" FMT_Word "\n", info_wix);
+ break; }
case bci_SWIZZLE: {
W_ stkoff = BCO_GET_LARGE_ARG;
StgInt by = BCO_GET_LARGE_ARG;
=====================================
rts/Hpc.c
=====================================
@@ -270,6 +270,9 @@ hs_hpc_module(char *modName,
HpcModuleInfo *tmpModule;
uint32_t i;
+ debugTrace(DEBUG_hpc, "hs_hpc_module(%s, count=%u, hash=%u)\n",
+ modName, modCount, modHashNo);
+
if (moduleHash == NULL) {
moduleHash = allocStrHashTable();
}
=====================================
rts/Interpreter.c
=====================================
@@ -1711,7 +1711,7 @@ run_BCO:
&&lbl_bci_TESTEQ_W8 - &&lbl_bci_DEFAULT,
&&lbl_bci_PRIMCALL - &&lbl_bci_DEFAULT,
&&lbl_bci_BCO_NAME - &&lbl_bci_DEFAULT,
- &&lbl_bci_DEFAULT - &&lbl_bci_DEFAULT,
+ &&lbl_bci_HPC_TICK - &&lbl_bci_DEFAULT,
&&lbl_bci_OP_ADD_64 - &&lbl_bci_DEFAULT,
&&lbl_bci_OP_SUB_64 - &&lbl_bci_DEFAULT,
&&lbl_bci_OP_AND_64 - &&lbl_bci_DEFAULT,
@@ -2078,6 +2078,15 @@ run_BCO:
NEXT_INSTRUCTION;
}
+ INSTRUCTION(bci_HPC_TICK): {
+ W_ arg1_ticks_array, arg2_tick_index;
+ arg1_ticks_array = BCO_GET_LARGE_ARG;
+ arg2_tick_index = BCO_READ_NEXT_32;
+
+ ((StgWord64*)BCO_LIT(arg1_ticks_array))[arg2_tick_index]++;
+ NEXT_INSTRUCTION;
+ }
+
INSTRUCTION(bci_STKCHECK): {
// Explicit stack check at the beginning of a function
// *only* (stack checks in case alternatives are
=====================================
rts/include/rts/Bytecodes.h
=====================================
@@ -118,6 +118,7 @@
#define bci_PRIMCALL 87
#define bci_BCO_NAME 88
+#define bci_HPC_TICK 89
#define bci_OP_ADD_64 90
#define bci_OP_SUB_64 91
=====================================
testsuite/tests/hpc/ghc_ghci/BytecodeMain.hs
=====================================
@@ -0,0 +1,10 @@
+module Main where
+
+inc :: Int -> Int
+inc x = x + 1
+
+double :: Int -> Int
+double x = x * 2
+
+main :: IO ()
+main = print (double (inc 1011))
=====================================
testsuite/tests/hpc/ghc_ghci/Makefile
=====================================
@@ -7,3 +7,9 @@ hpc_ghc_ghci:
'$(TEST_HC)' $(TEST_HC_OPTS) -fhpc -c A.hs
echo b | '$(TEST_HC)' $(TEST_HC_OPTS_INTERACTIVE) B.hs
+hpc_ghc_ghci_bytecode:
+ rm -f ./*.tix
+ printf "main\n:quit\n" | '$(TEST_HC)' $(TEST_HC_OPTS_INTERACTIVE) -fhpc -fbyte-code-and-object-code -fprefer-byte-code BytecodeMain.hs
+ @[ -f .hpc/Main.mix ] || (echo "ERROR: Expected .hpc/Main.mix file not found"; exit 1)
+ @set -- ./*.tix; [ -f "$$1" ] || (echo "ERROR: Expected .tix file not found"; exit 1); '$(HPC)' report "$$1" Main > hpc-report.txt
+ @grep -F "100% expressions used" hpc-report.txt >/dev/null || (echo "ERROR: Expected full expression coverage in hpc report"; cat hpc-report.txt; exit 1)
=====================================
testsuite/tests/hpc/ghc_ghci/hpc_ghc_ghci_bytecode.stdout
=====================================
@@ -0,0 +1 @@
+2024
=====================================
testsuite/tests/hpc/ghc_ghci/test.T
=====================================
@@ -3,3 +3,8 @@ test('hpc_ghc_ghci',
[extra_files(['A.hs', 'B.hs']),
only_ways(['normal']), when(compiler_profiled(), skip), req_interp],
run_command, ['$MAKE -s --no-print-directory hpc_ghc_ghci'])
+
+test('hpc_ghc_ghci_bytecode',
+ [extra_files(['BytecodeMain.hs']),
+ only_ways(['normal']), when(compiler_profiled(), skip), req_interp],
+ run_command, ['$MAKE -s --no-print-directory hpc_ghc_ghci_bytecode'])
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/2f87c2ad004113f2704f78b54fb3fdd…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/2f87c2ad004113f2704f78b54fb3fdd…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/fendor/hpc-bc-support] Make HPC work with bytecode interpreter
by Hannes Siebenhandl (＠fendor) 02 Apr '26
by Hannes Siebenhandl (＠fendor) 02 Apr '26
02 Apr '26
Hannes Siebenhandl pushed to branch wip/fendor/hpc-bc-support at Glasgow Haskell Compiler / GHC
Commits:
5d376a06 by fendor at 2026-04-02T11:04:44+02:00
Make HPC work with bytecode interpreter
Add support to generate .tix files from bytecode objects and the
bytecode interpreter.
Conceptually, we insert HPC ticks into the bytecode similar to how we insert
breakpoints.
HPC and breakpoints do not share the same tick array but we use a separate
tick-array for hpc/breakpoint ticks during bytecode generation.
We teach the bytecode interpreter to handle hpc ticks.
The implementation is quite trivial, simply increment the counter in the
global hpc_ticks array for the respective module.
This hpc_ticks array is generated as part of the `CStub`, so we can rely
on it existing.
A tricky bit is "registering" a bytecode object for HPC instrumentation.
In the compiled case, this is achieved via CStub and initializer/finalizers
`.init` sections which are called when the executable is run.
After the initializers have been invoked, which is before `hs_init_ghc`,
we then call `startup_hpc` in `hs_init_ghc` iff any modules were "registered"
for hpc instrumentation via `hs_hpc_module`.
Since bytecode objects are loaded after starting up GHCi, this workflow
doesn't work for supporting `hpc` and the `hpc` run-time is never
started, even if a module is added for instrumentation.
We fix this issue by employing the same technique as is for `SptEntry`s:
* We introduce a new field to `CompiledByteCode`, called `ByteCodeHpcInfo`
which contains enough information to call `hs_hpc_module`, allowing us to
register the module for `hpc` instrumentation`.
* After registering the module, we unconditionally call `startupHpc`, to make
sure the .tix file is written.
Calling `startupHpc` multiple times is safe.
Calling `hs_hpc_module` multiple times for the same module is also safe.
Evaluating a bytecode object instrumented with `-fhpc` without registering it
in the `hpc` run-time will simply not generate any `.tix` files for this
bytecode object.
Closes #27036
- - - - -
30 changed files:
- compiler/GHC/ByteCode/Asm.hs
- compiler/GHC/ByteCode/Binary.hs
- compiler/GHC/ByteCode/Instr.hs
- compiler/GHC/ByteCode/Types.hs
- compiler/GHC/Driver/Backend.hs
- compiler/GHC/Driver/CodeOutput.hs
- compiler/GHC/Driver/Main.hs
- compiler/GHC/Driver/Session.hs
- compiler/GHC/HsToCore.hs
- compiler/GHC/HsToCore/Coverage.hs
- compiler/GHC/HsToCore/Ticks.hs
- compiler/GHC/Iface/Tidy.hs
- compiler/GHC/Linker/Loader.hs
- compiler/GHC/Linker/Types.hs
- compiler/GHC/Runtime/Interpreter.hs
- compiler/GHC/StgToByteCode.hs
- compiler/GHC/Types/HpcInfo.hs
- compiler/GHC/Unit/Module/ModGuts.hs
- + libraries/ghci/GHCi/Coverage.hs
- libraries/ghci/GHCi/Message.hs
- libraries/ghci/GHCi/Run.hs
- libraries/ghci/ghci.cabal.in
- rts/Disassembler.c
- rts/Hpc.c
- rts/Interpreter.c
- rts/include/rts/Bytecodes.h
- + testsuite/tests/hpc/ghc_ghci/BytecodeMain.hs
- testsuite/tests/hpc/ghc_ghci/Makefile
- + testsuite/tests/hpc/ghc_ghci/hpc_ghc_ghci_bytecode.stdout
- testsuite/tests/hpc/ghc_ghci/test.T
Changes:
=====================================
compiler/GHC/ByteCode/Asm.hs
=====================================
@@ -72,6 +72,7 @@ import GHC.Float (castFloatToWord32, castDoubleToWord64)
import qualified Data.List as List ( any )
import GHC.Exts
+import qualified GHC.Data.Strict as Strict
-- -----------------------------------------------------------------------------
@@ -111,8 +112,9 @@ assembleBCOs
-> [(Name, ByteString)]
-> Maybe InternalModBreaks
-> [SptEntry]
+ -> Strict.Maybe ByteCodeHpcInfo
-> IO CompiledByteCode
-assembleBCOs profile proto_bcos tycons top_strs modbreaks spt_entries = do
+assembleBCOs profile proto_bcos tycons top_strs modbreaks spt_entries use_hpc = do
-- TODO: the profile should be bundled with the interpreter: the rts ways are
-- fixed for an interpreter
let itbls = mkITbls profile tycons
@@ -123,6 +125,7 @@ assembleBCOs profile proto_bcos tycons top_strs modbreaks spt_entries = do
, bc_strs = top_strs
, bc_breaks = modbreaks
, bc_spt_entries = spt_entries
+ , bc_hpc_info = use_hpc
}
-- Note [Allocating string literals]
@@ -856,6 +859,12 @@ assembleI platform i = case i of
emit_ bci_BRK_FUN [ Op p1, Op info_addr, Op info_unitid_addr
, SmallOp ix_hi, SmallOp ix_lo, Op np ]
+ HPC_TICK lbl ix -> do
+ p <- lit1 (BCONPtrLbl lbl)
+ let ix_hi = fromIntegral (ix `shiftR` 16)
+ ix_lo = fromIntegral (ix .&. 0xffff)
+ emit_ bci_HPC_TICK [Op p, SmallOp ix_hi, SmallOp ix_lo]
+
#if MIN_VERSION_rts(1,0,3)
BCO_NAME name -> do np <- lit1 (BCONPtrStr name)
emit_ bci_BCO_NAME [Op np]
=====================================
compiler/GHC/ByteCode/Binary.hs
=====================================
@@ -135,13 +135,15 @@ instance Binary CompiledByteCode where
replicateM bc_strs_len $ (,) <$> getViaBinName bh <*> get bh
bc_breaks <- get bh
bc_spt_entries <- get bh
+ bc_hpc_info <- get bh
return $
CompiledByteCode
{ bc_bcos,
bc_itbls,
bc_strs,
bc_breaks,
- bc_spt_entries
+ bc_spt_entries,
+ bc_hpc_info
}
put_ bh CompiledByteCode {..} = do
@@ -154,6 +156,26 @@ instance Binary CompiledByteCode where
for_ bc_strs $ \(nm, str) -> putViaBinName bh nm *> put_ bh str
put_ bh bc_breaks
put_ bh bc_spt_entries
+ put_ bh bc_hpc_info
+
+instance Binary ByteCodeHpcInfo where
+ put_ bh ByteCodeHpcInfo{bchi_tick_count,bchi_hash,bchi_tickbox_name,bchi_module_name} = do
+ put_ bh bchi_module_name
+ put_ bh bchi_tickbox_name
+ put_ bh bchi_tick_count
+ put_ bh bchi_hash
+
+ get bh = do
+ bchi_module_name <- get bh
+ bchi_tickbox_name <- get bh
+ bchi_tick_count <- get bh
+ bchi_hash <- get bh
+ pure ByteCodeHpcInfo
+ { bchi_tick_count
+ , bchi_hash
+ , bchi_tickbox_name
+ , bchi_module_name
+ }
instance Binary UnlinkedBCO where
get bh =
=====================================
compiler/GHC/ByteCode/Instr.hs
=====================================
@@ -15,6 +15,7 @@ import GHC.ByteCode.Types
import GHC.Cmm.Type (Width)
import GHC.StgToCmm.Layout ( ArgRep(..) )
import GHC.Utils.Outputable
+import GHC.Data.FastString ( FastString )
import GHC.Types.Name
import GHC.Types.Literal
import GHC.Types.Unique
@@ -257,6 +258,7 @@ data BCInstr
-- Breakpoints
| BRK_FUN !InternalBreakpointId
+ | HPC_TICK !FastString !Word32
#if MIN_VERSION_rts(1,0,3)
-- | A "meta"-instruction for recording the name of a BCO for debugging purposes.
@@ -452,6 +454,7 @@ instance Outputable BCInstr where
= text "BRK_FUN" <+> text "<breakarray>"
<+> ppr info_mod <+> ppr infox
<+> text "<cc>"
+ ppr (HPC_TICK lbl ix) = text "HPC_TICK" <+> ppr lbl <+> ppr ix
#if MIN_VERSION_rts(1,0,3)
ppr (BCO_NAME nm) = text "BCO_NAME" <+> text (show nm)
#endif
@@ -578,6 +581,7 @@ bciStackUse OP_INDEX_ADDR{} = 0
bciStackUse SWIZZLE{} = 0
bciStackUse BRK_FUN{} = 0
+bciStackUse HPC_TICK{} = 0
-- These insns actually reduce stack use, but we need the high-tide level,
-- so can't use this info. Not that it matters much.
=====================================
compiler/GHC/ByteCode/Types.hs
=====================================
@@ -25,6 +25,9 @@ module GHC.ByteCode.Types
-- * Mod Breaks
, ModBreaks (..), BreakpointId(..), BreakTickIndex
+ -- * Hpc Info
+ , ByteCodeHpcInfo(..)
+
-- * Internal Mod Breaks
, InternalModBreaks(..), CgBreakInfo(..), seqInternalModBreaks
-- ** Internal breakpoint identifier
@@ -35,6 +38,7 @@ import GHC.Prelude
import GHC.Data.FastString
import GHC.Data.FlatBag
+import qualified GHC.Data.Strict as Strict
import GHC.Types.Name
import GHC.Types.Name.Env
import GHC.Utils.Binary
@@ -79,6 +83,25 @@ data CompiledByteCode = CompiledByteCode
-- ^ Static pointer table entries which should be loaded along with the
-- BCOs. See Note [Grand plan for static forms] in
-- "GHC.Iface.Tidy.StaticPtrTable".
+
+ , bc_hpc_info :: !(Strict.Maybe ByteCodeHpcInfo)
+ -- ^ 'ByteCodeHpcInfo' that should be added to the run-time system when this 'CompiledByteCode'
+ -- object is loaded.
+ --
+ -- It is safe to load the same 'ByteCodeHpcInfo' multiple times.
+ }
+
+-- | ByteCode specific HPC information.
+--
+data ByteCodeHpcInfo = ByteCodeHpcInfo
+ { bchi_module_name :: !String
+ -- ^ Name of the module.
+ , bchi_tickbox_name :: !String
+ -- ^ Name of the tick box that has been added via 'CStub'.
+ , bchi_tick_count :: {-# UNPACK #-} !Int
+ -- ^ Number of ticks.
+ , bchi_hash :: {-# UNPACK #-} !Int
+ -- ^ mix-file hash.
}
-- | A libffi ffi_cif function prototype.
=====================================
compiler/GHC/Driver/Backend.hs
=====================================
@@ -712,8 +712,7 @@ backendSupportsHpc (Named NCG) = True
backendSupportsHpc (Named LLVM) = True
backendSupportsHpc (Named ViaC) = True
backendSupportsHpc (Named JavaScript) = False
--- TODO: @terrorjack thinks that the bytecode backend should support HPC now since (!13493)
-backendSupportsHpc (Named Bytecode) = False
+backendSupportsHpc (Named Bytecode) = True
backendSupportsHpc (Named NoBackend) = True
-- | This flag says whether the back end supports foreign
=====================================
compiler/GHC/Driver/CodeOutput.hs
=====================================
@@ -343,7 +343,6 @@ outputForeignStubs logger tmpfs dflags unit_state mod location stubs
cplusplus_hdr = "#if defined(__cplusplus)\nextern \"C\" {\n#endif\n"
cplusplus_ftr = "#if defined(__cplusplus)\n}\n#endif\n"
-
-- It is more than likely that the stubs file will
-- turn out to be empty, in which case no file should be created.
outputForeignStubs_help :: FilePath -> String -> String -> String -> IO Bool
=====================================
compiler/GHC/Driver/Main.hs
=====================================
@@ -134,6 +134,7 @@ import GHC.Driver.Config.Diagnostic
import GHC.Driver.Config.Tidy
import GHC.Driver.Hooks
import GHC.Driver.GenerateCgIPEStub (generateCgIPEStub, lookupEstimatedTicks)
+import GHC.Driver.Ppr (showSDoc)
import GHC.Runtime.Context
import GHC.Runtime.Interpreter
@@ -151,6 +152,7 @@ import GHC.Hs.Dump
import GHC.Hs.Stats ( ppSourceStats )
import GHC.HsToCore
+import GHC.HsToCore.Coverage ( hpcTickBoxes, hpcModuleName )
import GHC.StgToByteCode ( byteCodeGen )
import GHC.StgToJS ( stgToJS )
@@ -207,6 +209,8 @@ import qualified GHC.StgToCmm as StgToCmm ( codeGen )
import GHC.StgToCmm.Types (CmmCgInfos (..), ModuleLFInfos, LambdaFormInfo(..))
import GHC.StgToCmm.CgUtils (CgStream)
+import qualified GHC.ByteCode.Serialize as ByteCode
+
import GHC.Cmm
import GHC.Cmm.Info.Build
import GHC.Cmm.Pipeline
@@ -237,6 +241,7 @@ import GHC.Types.Var.Set
import GHC.Types.Error
import GHC.Types.Fixity.Env
import GHC.Types.CostCentre
+import GHC.Types.HpcInfo (HpcInfo (..))
import GHC.Types.IPE
import GHC.Types.SourceFile
import GHC.Types.SrcLoc
@@ -260,6 +265,7 @@ import GHC.Utils.Touch
import GHC.Data.FastString
import GHC.Data.Bag
import GHC.Data.OsPath (unsafeEncodeUtf)
+import qualified GHC.Data.Strict as Strict
import GHC.Data.StringBuffer
import qualified GHC.Data.Stream as Stream
import GHC.Data.Maybe
@@ -297,7 +303,6 @@ import GHC.Cmm.Config (CmmConfig)
import Data.Bifunctor
import qualified GHC.Unit.Home.Graph as HUG
import GHC.Unit.Home.PackageTable
-import qualified GHC.ByteCode.Serialize as ByteCode
{- **********************************************************************
%* *
@@ -1185,7 +1190,7 @@ compileWholeCoreBindings hsc_env type_env wcb = do
gen_bytecode core_binds stubs foreign_files = do
let cgi_guts = CgInteractiveGuts wcb_module core_binds
(typeEnvTyCons type_env) stubs foreign_files
- Nothing []
+ Nothing [] NoHpcInfo
trace_if logger (text "Generating ByteCode for" <+> ppr wcb_module)
mkModuleByteCode hsc_env wcb_module wcb_mod_location cgi_guts
@@ -2135,11 +2140,12 @@ data CgInteractiveGuts = CgInteractiveGuts { cgi_module :: Module
, cgi_foreign_files :: [(ForeignSrcLang, FilePath)]
, cgi_modBreaks :: Maybe ModBreaks
, cgi_spt_entries :: [SptEntry]
+ , cgi_hpc_info :: HpcInfo
}
mkCgInteractiveGuts :: CgGuts -> CgInteractiveGuts
-mkCgInteractiveGuts CgGuts{cg_module, cg_binds, cg_tycons, cg_foreign, cg_foreign_files, cg_modBreaks, cg_spt_entries}
- = CgInteractiveGuts cg_module cg_binds cg_tycons cg_foreign cg_foreign_files cg_modBreaks cg_spt_entries
+mkCgInteractiveGuts CgGuts{cg_module, cg_binds, cg_tycons, cg_foreign, cg_foreign_files, cg_modBreaks, cg_spt_entries, cg_hpc_info}
+ = CgInteractiveGuts cg_module cg_binds cg_tycons cg_foreign cg_foreign_files cg_modBreaks cg_spt_entries cg_hpc_info
hscInteractive :: HscEnv
-> CgInteractiveGuts
@@ -2162,13 +2168,15 @@ hscGenerateByteCode :: HscEnv -> CgInteractiveGuts -> ModLocation -> IO Compiled
hscGenerateByteCode hsc_env cgguts location = do
let dflags = hsc_dflags hsc_env
let logger = hsc_logger hsc_env
+ let platform = targetPlatform dflags
let CgInteractiveGuts{ -- This is the last use of the ModGuts in a compilation.
-- From now on, we just use the bits we need.
cgi_module = this_mod,
cgi_binds = core_binds,
cgi_tycons = tycons,
cgi_modBreaks = mod_breaks,
- cgi_spt_entries = spt_entries } = cgguts
+ cgi_spt_entries = spt_entries,
+ cgi_hpc_info = hpc_info } = cgguts
-------------------
-- ADD IMPLICIT BINDINGS
@@ -2193,8 +2201,22 @@ hscGenerateByteCode hsc_env cgguts location = do
let (stg_binds,_stg_deps) = unzip stg_binds_with_deps
+ -------------------
+ -- Setup HPC info
+ let
+ -- Strict to not retain a reference to the 'cgguts' via 'hpc_info'
+ !bytecodeHpcInfo = case hpc_info of
+ NoHpcInfo -> Strict.Nothing
+ HpcInfo{hpcInfoTickCount, hpcInfoHash} ->
+ Strict.Just ByteCodeHpcInfo
+ { bchi_tick_count = hpcInfoTickCount
+ , bchi_hash = hpcInfoHash
+ , bchi_tickboxes = showSDoc dflags $ hpcTickBoxes platform this_mod
+ , bchi_module_name = showSDoc dflags $ hpcModuleName this_mod
+ }
+
----------------- Generate byte code ------------------
- byteCodeGen hsc_env this_mod stg_binds tycons mod_breaks spt_entries
+ byteCodeGen hsc_env this_mod stg_binds tycons mod_breaks spt_entries bytecodeHpcInfo
-- | Generate a byte code object linkable and write it to a file if `-fwrite-byte-code` is enabled.
generateAndWriteByteCode :: HscEnv -> CgInteractiveGuts -> ModLocation -> IO ModuleByteCode
@@ -2843,6 +2865,7 @@ hscCompileCoreExpr' hsc_env srcspan ds_expr = do
[]
Nothing -- modbreaks
[] -- spt entries
+ Strict.Nothing -- no hpc info
{- load it -}
bco_time <- getCurrentTime
=====================================
compiler/GHC/Driver/Session.hs
=====================================
@@ -3791,12 +3791,6 @@ makeDynFlagsConsistent dflags
pgmError (backendDescription (backend dflags) ++
" supports only unregisterised ABI but target platform doesn't use it.")
- | gopt Opt_Hpc dflags && not (backendSupportsHpc (backend dflags))
- = let dflags' = gopt_unset dflags Opt_Hpc
- warn = "Hpc can't be used with " ++ backendDescription (backend dflags) ++
- ". Ignoring -fhpc."
- in loop dflags' warn
-
| backendSwappableWithViaC (backend dflags) &&
platformUnregisterised (targetPlatform dflags)
= loop (dflags { backend = viaCBackend })
=====================================
compiler/GHC/HsToCore.hs
=====================================
@@ -163,20 +163,20 @@ deSugar hsc_env
export_set (typeEnvTyCons type_env) binds
else return (binds, Nothing)
; let modBreaks
- | Just (_, specs) <- m_tickInfo
+ | Just (_, _, breakpointSpecs) <- m_tickInfo
, breakpointsAllowed dflags
- = Just $ mkModBreaks (interpreterProfiled $ hscInterp hsc_env) mod specs
+ = Just $ mkModBreaks (interpreterProfiled $ hscInterp hsc_env) mod breakpointSpecs
| otherwise
= Nothing
; ds_hpc_info <- case m_tickInfo of
- Just (orig_file2, ticks)
+ Just (orig_file2, hpcTicks, _)
| gopt Opt_Hpc $ hsc_dflags hsc_env
-> do
hashNo <- if gopt Opt_Hpc $ hsc_dflags hsc_env
- then writeMixEntries (hpcDir dflags) mod ticks orig_file2
+ then writeMixEntries (hpcDir dflags) mod hpcTicks orig_file2
else return 0 -- dummy hash when none are written
- pure $ HpcInfo (fromIntegral $ sizeSS ticks) hashNo
+ pure $ HpcInfo (fromIntegral $ sizeSS hpcTicks) hashNo
_ -> pure $ emptyHpcInfo
; (msgs, mb_res) <- initDs hsc_env tcg_env $
=====================================
compiler/GHC/HsToCore/Coverage.hs
=====================================
@@ -6,6 +6,9 @@
module GHC.HsToCore.Coverage
( writeMixEntries
, hpcInitCode
+ , hpcStubLabel
+ , hpcModuleName
+ , hpcTickBoxes
) where
import GHC.Prelude as Prelude
@@ -116,24 +119,33 @@ hpcInitCode _ _ (NoHpcInfo {}) = mempty
hpcInitCode platform this_mod (HpcInfo tickCount hashNo)
= initializerCStub platform fn_name decls body
where
- fn_name = mkInitializerStubLabel this_mod (fsLit "hpc")
+ fn_name = hpcStubLabel this_mod
decls = text "StgWord64 " <> tickboxes <> brackets (int tickCount) <> semi
body = text "hs_hpc_module" <>
parens (hcat (punctuate comma [
- doubleQuotes full_name_str,
+ doubleQuotes (hpcModuleName this_mod),
int tickCount, -- really StgWord32
int hashNo, -- really StgWord32
tickboxes
])) <> semi
+ tickboxes = hpcTickBoxes platform this_mod
- tickboxes = pprCLabel platform (mkHpcTicksLabel $ this_mod)
-
- module_name = hcat (map (text.charToC) $ BS.unpack $
- bytesFS (moduleNameFS (moduleName this_mod)))
- package_name = hcat (map (text.charToC) $ BS.unpack $
- bytesFS (unitFS (moduleUnit this_mod)))
- full_name_str
- | moduleUnit this_mod == mainUnit
- = module_name
- | otherwise
- = package_name <> char '/' <> module_name
+hpcStubLabel :: Module -> CLabel
+hpcStubLabel this_mod = mkInitializerStubLabel this_mod (fsLit "hpc")
+
+hpcModuleName :: Module -> SDoc
+hpcModuleName this_mod = full_name_str
+ where
+ full_name_str
+ | moduleUnit this_mod == mainUnit
+ = module_name
+ | otherwise
+ = package_name <> char '/' <> module_name
+ module_name = hcat (map (text.charToC) $ BS.unpack $
+ bytesFS (moduleNameFS (moduleName this_mod)))
+
+ package_name = hcat (map (text.charToC) $ BS.unpack $
+ bytesFS (unitFS (moduleUnit this_mod)))
+
+hpcTickBoxes :: Platform -> Module -> SDoc
+hpcTickBoxes platform this_mod = pprCLabel platform (mkHpcTicksLabel this_mod)
=====================================
compiler/GHC/HsToCore/Ticks.hs
=====================================
@@ -100,7 +100,7 @@ addTicksToBinds
-- hasn't set it), so we have to work from this set.
-> [TyCon] -- ^ Type constructors in this module
-> LHsBinds GhcTc
- -> IO (LHsBinds GhcTc, Maybe (FilePath, SizedSeq Tick))
+ -> IO (LHsBinds GhcTc, Maybe (FilePath, SizedSeq Tick, SizedSeq Tick))
addTicksToBinds logger cfg
mod mod_loc exports tyCons binds
@@ -133,12 +133,13 @@ addTicksToBinds logger cfg
(binds1,st) = foldr tickPass (binds, initTTState) passes
- extendedMixEntries = ticks st
+ hpcEntries = hpcTicks st
+ breakpointEntries = breakpointTicks st
putDumpFileMaybe logger Opt_D_dump_ticked "HPC" FormatHaskell
(pprLHsBinds binds1)
- return (binds1, Just (orig_file2, extendedMixEntries))
+ return (binds1, Just (orig_file2, hpcEntries, breakpointEntries))
| otherwise = return (binds, Nothing)
@@ -1050,23 +1051,31 @@ addTickArithSeqInfo (FromThenTo e1 e2 e3) =
(addTickLHsExpr e2)
(addTickLHsExpr e3)
-data TickTransState = TT { ticks :: !(SizedSeq Tick)
- , ccIndices :: !CostCentreState
- , recSelTicks :: !(IdEnv CoreTickish)
+data TickTransState = TT { hpcTicks :: !(SizedSeq Tick)
+ , breakpointTicks :: !(SizedSeq Tick)
+ , ccIndices :: !CostCentreState
+ , recSelTicks :: !(IdEnv CoreTickish)
}
initTTState :: TickTransState
-initTTState = TT { ticks = emptySS
- , ccIndices = newCostCentreState
- , recSelTicks = emptyVarEnv
+initTTState = TT { hpcTicks = emptySS
+ , breakpointTicks = emptySS
+ , ccIndices = newCostCentreState
+ , recSelTicks = emptyVarEnv
}
-addMixEntry :: Tick -> TM Int
-addMixEntry ent = do
- c <- fromIntegral . sizeSS . ticks <$> getState
+addHpcEntry :: Tick -> TM Int
+addHpcEntry ent = do
+ c <- fromIntegral . sizeSS . hpcTicks <$> getState
setState $ \st ->
- st { ticks = addToSS (ticks st) ent
- }
+ st { hpcTicks = addToSS (hpcTicks st) ent }
+ return c
+
+addBreakpointEntry :: Tick -> TM Int
+addBreakpointEntry ent = do
+ c <- fromIntegral . sizeSS . breakpointTicks <$> getState
+ setState $ \st ->
+ st { breakpointTicks = addToSS (breakpointTicks st) ent }
return c
addRecSelTick :: Id -> CoreTickish -> TM ()
@@ -1291,7 +1300,7 @@ mkTickish boxLabel countEntries topOnly pos fvs decl_path = do
env <- getEnv
case tickishType env of
- HpcTicks -> HpcTick (this_mod env) <$> addMixEntry me
+ HpcTicks -> HpcTick (this_mod env) <$> addHpcEntry me
ProfNotes -> do
flavour <- mkHpcCCFlavour <$> getCCIndexM cc_name
@@ -1300,7 +1309,7 @@ mkTickish boxLabel countEntries topOnly pos fvs decl_path = do
return $ ProfNote cc count True{-scopes-}
Breakpoints -> do
- i <- addMixEntry me
+ i <- addBreakpointEntry me
pure (Breakpoint noExtField (BreakpointId (this_mod env) i) ids)
SourceNotes | RealSrcSpan pos' _ <- pos ->
@@ -1325,19 +1334,19 @@ mkBinTickBoxHpc :: (Bool -> BoxLabel) -> SrcSpan -> LHsExpr GhcTc
mkBinTickBoxHpc boxLabel pos e = do
env <- getEnv
binTick <- HsBinTick
- <$> addMixEntry (Tick { tick_loc = pos
+ <$> addHpcEntry (Tick { tick_loc = pos
, tick_path = declPath env
, tick_ids = []
, tick_label = boxLabel True
})
- <*> addMixEntry (Tick { tick_loc = pos
+ <*> addHpcEntry (Tick { tick_loc = pos
, tick_path = declPath env
, tick_ids = []
, tick_label = boxLabel False
})
<*> pure e
tick <- HpcTick (this_mod env)
- <$> addMixEntry (Tick { tick_loc = pos
+ <$> addHpcEntry (Tick { tick_loc = pos
, tick_path = declPath env
, tick_ids = []
, tick_label = ExpBox False
=====================================
compiler/GHC/Iface/Tidy.hs
=====================================
@@ -402,6 +402,7 @@ tidyProgram opts (ModGuts { mg_module = mod
, mg_foreign_files = foreign_files
, mg_modBreaks = modBreaks
, mg_boot_exports = boot_exports
+ , mg_hpc_info = hpc_info
}) = do
(unfold_env, tidy_occ_env) <- chooseExternalIds opts mod tcs binds imp_rules
@@ -471,6 +472,7 @@ tidyProgram opts (ModGuts { mg_module = mod
, cg_dep_pkgs = S.map snd (dep_direct_pkgs deps)
, cg_modBreaks = modBreaks
, cg_spt_entries = spt_entries
+ , cg_hpc_info = hpc_info
}
, ModDetails { md_types = tidy_type_env
, md_rules = tidy_rules
=====================================
compiler/GHC/Linker/Loader.hs
=====================================
@@ -65,9 +65,10 @@ import GHCi.RemoteTypes
import GHC.Iface.Load
import GHCi.Message
+import GHC.ByteCode.Asm
import GHC.ByteCode.Breakpoints
import GHC.ByteCode.Linker
-import GHC.ByteCode.Asm
+import GHC.ByteCode.Serialize
import GHC.ByteCode.Types
import GHC.Linker.Unit (getUnitDepends)
@@ -97,8 +98,9 @@ import GHC.Unit.Module.Graph
import GHC.Unit.Module.ModIface
import GHC.Unit.State as Packages
-import qualified GHC.Data.ShortText as ST
import GHC.Data.FastString
+import qualified GHC.Data.ShortText as ST
+import qualified GHC.Data.Strict as Strict
import GHC.Linker.Deps
import GHC.Linker.MacOS
@@ -136,7 +138,6 @@ import qualified GHC.Runtime.Interpreter as GHCi
import qualified Data.IntMap.Strict as IM
import qualified Data.Map.Strict as M
import Foreign.Ptr (nullPtr)
-import GHC.ByteCode.Serialize
-- Note [Linkers and loaders]
-- ~~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -1025,6 +1026,8 @@ dynLinkCompiledByteCode interp pkgs_loaded whole_bytecode_state traverse_bytecod
let ce2 = extendClosureEnv (closure_env (bco_linker_env bytecode_state)) new_binds
-- Add SPT entries
mapM_ (linkSptEntry interp ce2) (concatMap bc_spt_entries cbcs)
+ -- Load HPC modules
+ mapM_ (linkHpcEntry interp . bc_hpc_info) cbcs
return $! bytecode_state { bco_linker_env = (bco_linker_env bytecode_state) { closure_env = ce2 } }
-- | Register SPT entries for this module in the interpreter
@@ -1037,8 +1040,14 @@ linkSptEntry interp ce (SptEntry name fpr) = do
Nothing -> pprPanic "linkSptEntry" (ppr name)
Just (_, hval) -> addSptEntry interp fpr hval
-
-
+linkHpcEntry :: Interp -> Strict.Maybe ByteCodeHpcInfo -> IO ()
+linkHpcEntry _interp Strict.Nothing = pure ()
+linkHpcEntry interp (Strict.Just info) = do
+ addHpcModule interp
+ (bchi_module_name info)
+ (bchi_tick_count info)
+ (bchi_hash info)
+ (bchi_tickbox_name info)
-- Link a bunch of BCOs and return references to their values
linkSomeBCOs :: Interp
=====================================
compiler/GHC/Linker/Types.hs
=====================================
@@ -214,36 +214,37 @@ data BytecodeLoaderState = BytecodeLoaderState
-- ^ Information about bytecode objects from the home package we have loaded into the interpreter.
, externalPackage_loaded :: BytecodeState
-- ^ Information about bytecode objects from external packages we have loaded into the interpreter.
+ , hpcInitialised :: !Bool
}
-- | Find a name loaded from bytecode
lookupNameBytecodeState :: BytecodeLoaderState -> Name -> Maybe (Name, ForeignHValue)
-lookupNameBytecodeState (BytecodeLoaderState home_package external_package) name = do
+lookupNameBytecodeState (BytecodeLoaderState home_package external_package _) name = do
lookupNameEnv (closure_env (bco_linker_env home_package)) name
<|> lookupNameEnv (closure_env (bco_linker_env external_package)) name
-- | Look up a break array in the bytecode loader state.
lookupBreakArrayBytecodeState :: BytecodeLoaderState -> Module -> Maybe (ForeignRef BreakArray)
-lookupBreakArrayBytecodeState (BytecodeLoaderState home_package external_package) break_mod = do
+lookupBreakArrayBytecodeState (BytecodeLoaderState home_package external_package _) break_mod = do
lookupModuleEnv (breakarray_env (bco_linked_breaks home_package)) break_mod
<|> lookupModuleEnv (breakarray_env (bco_linked_breaks external_package)) break_mod
-- | Look up an info table in the bytecode loader state.
lookupInfoTableBytecodeState :: BytecodeLoaderState -> Name -> Maybe (Name, ItblPtr)
-lookupInfoTableBytecodeState (BytecodeLoaderState home_package external_package) info_mod = do
+lookupInfoTableBytecodeState (BytecodeLoaderState home_package external_package _) info_mod = do
lookupNameEnv (itbl_env (bco_linker_env home_package)) info_mod
<|> lookupNameEnv (itbl_env (bco_linker_env external_package)) info_mod
-- | Look up an address in the bytecode loader state.
lookupAddressBytecodeState :: BytecodeLoaderState -> Name -> Maybe (Name, AddrPtr)
-lookupAddressBytecodeState (BytecodeLoaderState home_package external_package) addr_mod = do
+lookupAddressBytecodeState (BytecodeLoaderState home_package external_package _) addr_mod = do
lookupNameEnv (addr_env (bco_linker_env home_package)) addr_mod
<|> lookupNameEnv (addr_env (bco_linker_env external_package)) addr_mod
-- | Look up a cost centre stack in the bytecode loader state.
lookupCCSBytecodeState :: BytecodeLoaderState -> Module -> Maybe (Array BreakTickIndex (RemotePtr CostCentre))
-lookupCCSBytecodeState (BytecodeLoaderState home_package external_package) ccs_mod = do
+lookupCCSBytecodeState (BytecodeLoaderState home_package external_package _) ccs_mod = do
lookupModuleEnv (ccs_env (bco_linked_breaks home_package)) ccs_mod
<|> lookupModuleEnv (ccs_env (bco_linked_breaks external_package)) ccs_mod
@@ -251,6 +252,7 @@ emptyBytecodeLoaderState :: BytecodeLoaderState
emptyBytecodeLoaderState = BytecodeLoaderState
{ homePackage_loaded = emptyBytecodeState
, externalPackage_loaded = emptyBytecodeState
+ , hpcInitialised = False
}
emptyBytecodeState :: BytecodeState
=====================================
compiler/GHC/Runtime/Interpreter.hs
=====================================
@@ -17,6 +17,7 @@ module GHC.Runtime.Interpreter
, mallocData
, createBCOs
, addSptEntry
+ , addHpcModule
, mkCostCentres
, costCentreStackInfo
, newBreakArray
@@ -366,6 +367,10 @@ addSptEntry interp fpr ref =
withForeignRef ref $ \val ->
interpCmd interp (AddSptEntry fpr val)
+addHpcModule :: Interp -> String -> Int -> Int -> String -> IO ()
+addHpcModule interp modLabel tickNo hash tickboxes =
+ interpCmd interp (AddHpcModule modLabel tickNo hash tickboxes)
+
costCentreStackInfo :: Interp -> RemotePtr CostCentreStack -> IO [String]
costCentreStackInfo interp ccs =
interpCmd interp (CostCentreStackInfo ccs)
=====================================
compiler/GHC/StgToByteCode.hs
=====================================
@@ -20,6 +20,7 @@ import GHC.ByteCode.Types
import GHC.Cmm.CallConv
import GHC.Cmm.Expr
+import GHC.Cmm.CLabel (mkHpcTicksLabel, pprCLabel)
import GHC.Cmm.Reg ( GlobalArgRegs(..) )
import GHC.Cmm.Node
import GHC.Cmm.Utils
@@ -97,6 +98,7 @@ import Control.Monad.IO.Class
import Control.Monad.Trans.Reader (ReaderT(..))
import Control.Monad.Trans.State (StateT(..))
import Data.Bifunctor (Bifunctor(..))
+import qualified GHC.Data.Strict as Strict
-- -----------------------------------------------------------------------------
-- Generating byte code for a complete module
@@ -107,8 +109,9 @@ byteCodeGen :: HscEnv
-> [TyCon]
-> Maybe ModBreaks
-> [SptEntry]
+ -> Strict.Maybe ByteCodeHpcInfo
-> IO CompiledByteCode
-byteCodeGen hsc_env this_mod binds tycs mb_modBreaks spt_entries
+byteCodeGen hsc_env this_mod binds tycs mb_modBreaks spt_entries hpc_info
= withTiming logger
(text "GHC.StgToByteCode"<+>brackets (ppr this_mod))
(const ()) $ do
@@ -134,7 +137,7 @@ byteCodeGen hsc_env this_mod binds tycs mb_modBreaks spt_entries
let mod_breaks = case mb_modBreaks of
Nothing -> Nothing
Just mb -> Just $ mkInternalModBreaks this_mod breakInfo mb
- cbc <- assembleBCOs profile proto_bcos tycs strings mod_breaks spt_entries
+ cbc <- assembleBCOs profile proto_bcos tycs strings mod_breaks spt_entries hpc_info
-- Squash space leaks in the CompiledByteCode. This is really
-- important, because when loading a set of modules into GHCi
@@ -604,6 +607,11 @@ schemeE _d _s _p (StgTick (Breakpoint _ bp_id _) _rhs)
= pprPanic "schemeE: Breakpoint without let binding:"
(ppr bp_id <+> text "forgot to run bcPrep?")
+schemeE d s p (StgTick (HpcTick mod ix) rhs) = do
+ platform <- profilePlatform <$> getProfile
+ rhs_code <- schemeE d s p rhs
+ pure (unitOL (HPC_TICK (mkHpcTickLabel platform mod) (fromIntegral ix)) `appOL` rhs_code)
+
-- ignore other kinds of tick
schemeE d s p (StgTick _ rhs) = schemeE d s p rhs
@@ -2784,6 +2792,10 @@ getLastBreakTick = BcM $ \env st ->
tickFS :: FastString
tickFS = fsLit "ticked"
+mkHpcTickLabel :: Platform -> Module -> FastString
+mkHpcTickLabel platform mod =
+ fsLit (showSDocOneLine defaultSDocContext (pprCLabel platform (mkHpcTicksLabel mod)))
+
-- Dehydrating CgBreakInfo
dehydrateCgBreakInfo :: [TyVar] -> [Maybe (Id, Word)] -> Type -> Either InternalBreakLoc BreakpointId -> CgBreakInfo
=====================================
compiler/GHC/Types/HpcInfo.hs
=====================================
@@ -18,4 +18,3 @@ data HpcInfo
emptyHpcInfo :: HpcInfo
emptyHpcInfo = NoHpcInfo
-
=====================================
compiler/GHC/Unit/Module/ModGuts.hs
=====================================
@@ -141,8 +141,9 @@ data CgGuts
cg_dep_pkgs :: !(Set UnitId), -- ^ Dependent packages, used to
-- generate #includes for C code gen
cg_modBreaks :: !(Maybe ModBreaks), -- ^ Module breakpoints
- cg_spt_entries :: [SptEntry]
+ cg_spt_entries :: [SptEntry],
-- ^ Static pointer table entries for static forms defined in
-- the module.
-- See Note [Grand plan for static forms] in "GHC.Iface.Tidy.StaticPtrTable"
+ cg_hpc_info :: HpcInfo
}
=====================================
libraries/ghci/GHCi/Coverage.hs
=====================================
@@ -0,0 +1,51 @@
+{-# LANGUAGE ForeignFunctionInterface #-}
+{-# LANGUAGE LambdaCase #-}
+
+module GHCi.Coverage (
+ hpcAddModule,
+ ) where
+
+import Prelude -- See note [Why do we import Prelude here?]
+
+import Control.Exception
+import qualified Data.ByteString.Char8 as BS8
+import qualified Data.ByteString.Unsafe as B
+import Data.Word
+import Foreign
+import Foreign.C.String (withCAString)
+import GHC.Fingerprint
+import GHC.Foreign (CString)
+import GHCi.ObjLink (lookupSymbol)
+
+-- | Inform the run-time system that the given module name is instrumented via @hpc@
+-- and to collect @.tix@ info.
+--
+-- Starts the `hpc` run-time if it hasn't already been started.
+hpcAddModule ::
+ String ->
+ -- ^ Name of the module to instrument
+ Int ->
+ -- ^ Number of hpc ticks in this module
+ Int ->
+ -- ^ 'HpcInfo's 'hpcInfoHash'
+ String ->
+ -- ^ Name of the ticks array found in the c-stub.
+ IO ()
+hpcAddModule modlName ticks hash tickboxes = do
+ withCAString modlName $ \modlNameLiteral -> do
+ -- we need to find the reference to the ticks array.
+ lookupSymbol tickboxes >>= \ case
+ Nothing -> do
+ -- the symbol is not found, this is a bug!
+ throwIO $ ErrorCall $ "hpcAddModule: failed to find symbol " <> tickboxes
+ Just tickBoxRef -> do
+ -- Calling 'hs_hpc_module' multiple times is safe, it will add the module only once.
+ hpc_register_module modlNameLiteral (fromIntegral ticks) (fromIntegral hash) (castPtr tickBoxRef)
+ -- calling 'hpc_startup' multiple times is safe, it will only be initialised once.
+ hpc_startup
+
+foreign import ccall "hs_hpc_module"
+ hpc_register_module :: CString -> Word32 -> Word32 -> Ptr Word64 -> IO ()
+
+foreign import ccall "startupHpc"
+ hpc_startup :: IO ()
=====================================
libraries/ghci/GHCi/Message.hs
=====================================
@@ -111,6 +111,8 @@ data Message a where
-- | Add entries to the Static Pointer Table
AddSptEntry :: Fingerprint -> HValueRef -> Message ()
+ -- | Add module to hpc
+ AddHpcModule :: String -> Int -> Int -> String -> Message ()
-- | Malloc some data and return a 'RemotePtr' to it
MallocData :: ByteString -> Message (RemotePtr ())
@@ -607,7 +609,8 @@ getMessage = do
38 -> Msg <$> (ResumeSeq <$> get)
39 -> Msg <$> (LookupSymbolInDLL <$> get <*> get)
40 -> Msg <$> (WhereFrom <$> get)
- 41 -> Msg <$> (CustomMessage <$> get <*> get)
+ 41 -> Msg <$> (AddHpcModule <$> get <*> get <*> get <*> get)
+ 42 -> Msg <$> (CustomMessage <$> get <*> get)
_ -> error $ "Unknown Message code " ++ (show b)
putMessage :: Message a -> Put
@@ -654,7 +657,8 @@ putMessage m = case m of
ResumeSeq a -> putWord8 38 >> put a
LookupSymbolInDLL dll str -> putWord8 39 >> put dll >> put str
WhereFrom a -> putWord8 40 >> put a
- CustomMessage tag payload -> putWord8 41 >> put tag >> put payload
+ AddHpcModule m n h ticks -> putWord8 41 >> put m >> put n >> put h >> put ticks
+ CustomMessage tag payload -> putWord8 42 >> put tag >> put payload
{-
Note [Parallelize CreateBCOs serialization]
=====================================
libraries/ghci/GHCi/Run.hs
=====================================
@@ -19,6 +19,7 @@ import GHCi.CreateBCO
import GHCi.InfoTable
#endif
+import GHCi.Coverage
import qualified GHC.InfoProv as InfoProv
import GHCi.Debugger
import GHCi.FFI
@@ -88,6 +89,7 @@ run m = case m of
fmap toRemotePtr <$> lookupSymbolInDLL (fromRemotePtr dll) str
FreeHValueRefs rs -> mapM_ freeRemoteRef rs
AddSptEntry fpr r -> localRef r >>= sptAddEntry fpr
+ AddHpcModule modl ticks hash tickboxes -> hpcAddModule modl ticks hash tickboxes
EvalStmt opts r -> evalStmt opts r
ResumeStmt opts r -> resumeStmt opts r
AbandonStmt r -> abandonStmt r
=====================================
libraries/ghci/ghci.cabal.in
=====================================
@@ -59,6 +59,7 @@ library
if flag(internal-interpreter)
CPP-Options: -DHAVE_INTERNAL_INTERPRETER
exposed-modules:
+ GHCi.Coverage
GHCi.Run
GHCi.Debugger
GHCi.CreateBCO
=====================================
rts/Disassembler.c
=====================================
@@ -101,6 +101,13 @@ disInstr ( StgBCO *bco, int pc )
}
debugBelch("\n");
break; }
+ case bci_HPC_TICK: {
+ W_ p1, info_wix;
+ p1 = BCO_GET_LARGE_ARG;
+ info_wix = BCO_READ_NEXT_32;
+ debugBelch("HPC_TICK "); printPtr((StgPtr)literals[p1]);
+ debugBelch(" %" FMT_Word "\n", info_wix);
+ break; }
case bci_SWIZZLE: {
W_ stkoff = BCO_GET_LARGE_ARG;
StgInt by = BCO_GET_LARGE_ARG;
=====================================
rts/Hpc.c
=====================================
@@ -270,6 +270,9 @@ hs_hpc_module(char *modName,
HpcModuleInfo *tmpModule;
uint32_t i;
+ debugTrace(DEBUG_hpc, "hs_hpc_module(%s, count=%u, hash=%u)\n",
+ modName, modCount, modHashNo);
+
if (moduleHash == NULL) {
moduleHash = allocStrHashTable();
}
=====================================
rts/Interpreter.c
=====================================
@@ -1711,7 +1711,7 @@ run_BCO:
&&lbl_bci_TESTEQ_W8 - &&lbl_bci_DEFAULT,
&&lbl_bci_PRIMCALL - &&lbl_bci_DEFAULT,
&&lbl_bci_BCO_NAME - &&lbl_bci_DEFAULT,
- &&lbl_bci_DEFAULT - &&lbl_bci_DEFAULT,
+ &&lbl_bci_HPC_TICK - &&lbl_bci_DEFAULT,
&&lbl_bci_OP_ADD_64 - &&lbl_bci_DEFAULT,
&&lbl_bci_OP_SUB_64 - &&lbl_bci_DEFAULT,
&&lbl_bci_OP_AND_64 - &&lbl_bci_DEFAULT,
@@ -2078,6 +2078,18 @@ run_BCO:
NEXT_INSTRUCTION;
}
+ INSTRUCTION(bci_HPC_TICK): {
+ W_ arg1_ticks_array, arg2_tick_index;
+ arg1_ticks_array = BCO_GET_LARGE_ARG;
+ arg2_tick_index = BCO_READ_NEXT_32;
+ IF_DEBUG(hpc,
+ debugBelch("\tHPC Tick %lu %lu %lu\n", BCO_LIT(arg1_ticks_array), arg1_ticks_array, arg2_tick_index);
+ );
+
+ ((StgWord64*)BCO_LIT(arg1_ticks_array))[arg2_tick_index]++;
+ NEXT_INSTRUCTION;
+ }
+
INSTRUCTION(bci_STKCHECK): {
// Explicit stack check at the beginning of a function
// *only* (stack checks in case alternatives are
=====================================
rts/include/rts/Bytecodes.h
=====================================
@@ -118,6 +118,7 @@
#define bci_PRIMCALL 87
#define bci_BCO_NAME 88
+#define bci_HPC_TICK 89
#define bci_OP_ADD_64 90
#define bci_OP_SUB_64 91
=====================================
testsuite/tests/hpc/ghc_ghci/BytecodeMain.hs
=====================================
@@ -0,0 +1,10 @@
+module Main where
+
+inc :: Int -> Int
+inc x = x + 1
+
+double :: Int -> Int
+double x = x * 2
+
+main :: IO ()
+main = print (double (inc 1011))
=====================================
testsuite/tests/hpc/ghc_ghci/Makefile
=====================================
@@ -7,3 +7,9 @@ hpc_ghc_ghci:
'$(TEST_HC)' $(TEST_HC_OPTS) -fhpc -c A.hs
echo b | '$(TEST_HC)' $(TEST_HC_OPTS_INTERACTIVE) B.hs
+hpc_ghc_ghci_bytecode:
+ rm -f ./*.tix
+ printf "main\n:quit\n" | '$(TEST_HC)' $(TEST_HC_OPTS_INTERACTIVE) -fhpc -fbyte-code-and-object-code -fprefer-byte-code BytecodeMain.hs
+ @[ -f .hpc/Main.mix ] || (echo "ERROR: Expected .hpc/Main.mix file not found"; exit 1)
+ @set -- ./*.tix; [ -f "$$1" ] || (echo "ERROR: Expected .tix file not found"; exit 1); '$(HPC)' report "$$1" Main > hpc-report.txt
+ @grep -F "100% expressions used" hpc-report.txt >/dev/null || (echo "ERROR: Expected full expression coverage in hpc report"; cat hpc-report.txt; exit 1)
=====================================
testsuite/tests/hpc/ghc_ghci/hpc_ghc_ghci_bytecode.stdout
=====================================
@@ -0,0 +1 @@
+2024
=====================================
testsuite/tests/hpc/ghc_ghci/test.T
=====================================
@@ -3,3 +3,8 @@ test('hpc_ghc_ghci',
[extra_files(['A.hs', 'B.hs']),
only_ways(['normal']), when(compiler_profiled(), skip), req_interp],
run_command, ['$MAKE -s --no-print-directory hpc_ghc_ghci'])
+
+test('hpc_ghc_ghci_bytecode',
+ [extra_files(['BytecodeMain.hs']),
+ only_ways(['normal']), when(compiler_profiled(), skip), req_interp],
+ run_command, ['$MAKE -s --no-print-directory hpc_ghc_ghci_bytecode'])
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/5d376a069b6549db4b405ded771a253…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/5d376a069b6549db4b405ded771a253…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/fendor/hpc-bc-support] Make HPC work with bytecode interpreter
by Hannes Siebenhandl (＠fendor) 02 Apr '26
by Hannes Siebenhandl (＠fendor) 02 Apr '26
02 Apr '26
Hannes Siebenhandl pushed to branch wip/fendor/hpc-bc-support at Glasgow Haskell Compiler / GHC
Commits:
51d6c658 by fendor at 2026-04-02T11:00:57+02:00
Make HPC work with bytecode interpreter
Add support to generate .tix files from bytecode objects and the
bytecode interpreter.
Conceptually, we insert HPC ticks into the bytecode similar to how we insert
breakpoints.
HPC and breakpoints do not share the same tick array but we use a separate
tick-array for hpc/breakpoint ticks during bytecode generation.
We teach the bytecode interpreter to handle hpc ticks.
The implementation is quite trivial, simply increment the counter in the
global hpc_ticks array for the respective module.
This hpc_ticks array is generated as part of the `CStub`, so we can rely
on it existing.
A tricky bit is "registering" a bytecode object for HPC instrumentation.
In the compiled case, this is achieved via CStub and initializer/finalizers
`.init` sections which are called when the executable is run.
After the initializers have been invoked, which is before `hs_init_ghc`,
we then call `startup_hpc` in `hs_init_ghc` iff any modules were "registered"
for hpc instrumentation via `hs_hpc_module`.
Since bytecode objects are loaded after starting up GHCi, this workflow
doesn't work for supporting `hpc` and the `hpc` run-time is never
started, even if a module is added for instrumentation.
We fix this issue by employing the same technique as is for `SptEntry`s:
* We introduce a new field to `CompiledByteCode`, called `ByteCodeHpcInfo`
which contains enough information to call `hs_hpc_module`, allowing us to
register the module for `hpc` instrumentation`.
* After registering the module, we unconditionally call `startupHpc`, to make
sure the .tix file is written.
Calling `startupHpc` multiple times is safe.
Calling `hs_hpc_module` multiple times for the same module is also safe.
Evaluating a bytecode object instrumented with `-fhpc` without registering it
in the `hpc` run-time will simply not generate any `.tix` files for this
bytecode object.
Closes #27036
- - - - -
29 changed files:
- compiler/GHC/ByteCode/Asm.hs
- compiler/GHC/ByteCode/Instr.hs
- compiler/GHC/ByteCode/Types.hs
- compiler/GHC/Driver/Backend.hs
- compiler/GHC/Driver/CodeOutput.hs
- compiler/GHC/Driver/Main.hs
- compiler/GHC/Driver/Session.hs
- compiler/GHC/HsToCore.hs
- compiler/GHC/HsToCore/Coverage.hs
- compiler/GHC/HsToCore/Ticks.hs
- compiler/GHC/Iface/Tidy.hs
- compiler/GHC/Linker/Loader.hs
- compiler/GHC/Linker/Types.hs
- compiler/GHC/Runtime/Interpreter.hs
- compiler/GHC/StgToByteCode.hs
- compiler/GHC/Types/HpcInfo.hs
- compiler/GHC/Unit/Module/ModGuts.hs
- + libraries/ghci/GHCi/Coverage.hs
- libraries/ghci/GHCi/Message.hs
- libraries/ghci/GHCi/Run.hs
- libraries/ghci/ghci.cabal.in
- rts/Disassembler.c
- rts/Hpc.c
- rts/Interpreter.c
- rts/include/rts/Bytecodes.h
- + testsuite/tests/hpc/ghc_ghci/BytecodeMain.hs
- testsuite/tests/hpc/ghc_ghci/Makefile
- + testsuite/tests/hpc/ghc_ghci/hpc_ghc_ghci_bytecode.stdout
- testsuite/tests/hpc/ghc_ghci/test.T
Changes:
=====================================
compiler/GHC/ByteCode/Asm.hs
=====================================
@@ -72,6 +72,7 @@ import GHC.Float (castFloatToWord32, castDoubleToWord64)
import qualified Data.List as List ( any )
import GHC.Exts
+import qualified GHC.Data.Strict as Strict
-- -----------------------------------------------------------------------------
@@ -111,8 +112,9 @@ assembleBCOs
-> [(Name, ByteString)]
-> Maybe InternalModBreaks
-> [SptEntry]
+ -> Strict.Maybe ByteCodeHpcInfo
-> IO CompiledByteCode
-assembleBCOs profile proto_bcos tycons top_strs modbreaks spt_entries = do
+assembleBCOs profile proto_bcos tycons top_strs modbreaks spt_entries use_hpc = do
-- TODO: the profile should be bundled with the interpreter: the rts ways are
-- fixed for an interpreter
let itbls = mkITbls profile tycons
@@ -123,6 +125,7 @@ assembleBCOs profile proto_bcos tycons top_strs modbreaks spt_entries = do
, bc_strs = top_strs
, bc_breaks = modbreaks
, bc_spt_entries = spt_entries
+ , bc_hpc_info = use_hpc
}
-- Note [Allocating string literals]
@@ -856,6 +859,12 @@ assembleI platform i = case i of
emit_ bci_BRK_FUN [ Op p1, Op info_addr, Op info_unitid_addr
, SmallOp ix_hi, SmallOp ix_lo, Op np ]
+ HPC_TICK lbl ix -> do
+ p <- lit1 (BCONPtrLbl lbl)
+ let ix_hi = fromIntegral (ix `shiftR` 16)
+ ix_lo = fromIntegral (ix .&. 0xffff)
+ emit_ bci_HPC_TICK [Op p, SmallOp ix_hi, SmallOp ix_lo]
+
#if MIN_VERSION_rts(1,0,3)
BCO_NAME name -> do np <- lit1 (BCONPtrStr name)
emit_ bci_BCO_NAME [Op np]
=====================================
compiler/GHC/ByteCode/Instr.hs
=====================================
@@ -15,6 +15,7 @@ import GHC.ByteCode.Types
import GHC.Cmm.Type (Width)
import GHC.StgToCmm.Layout ( ArgRep(..) )
import GHC.Utils.Outputable
+import GHC.Data.FastString ( FastString )
import GHC.Types.Name
import GHC.Types.Literal
import GHC.Types.Unique
@@ -257,6 +258,7 @@ data BCInstr
-- Breakpoints
| BRK_FUN !InternalBreakpointId
+ | HPC_TICK !FastString !Word32
#if MIN_VERSION_rts(1,0,3)
-- | A "meta"-instruction for recording the name of a BCO for debugging purposes.
@@ -452,6 +454,7 @@ instance Outputable BCInstr where
= text "BRK_FUN" <+> text "<breakarray>"
<+> ppr info_mod <+> ppr infox
<+> text "<cc>"
+ ppr (HPC_TICK lbl ix) = text "HPC_TICK" <+> ppr lbl <+> ppr ix
#if MIN_VERSION_rts(1,0,3)
ppr (BCO_NAME nm) = text "BCO_NAME" <+> text (show nm)
#endif
@@ -578,6 +581,7 @@ bciStackUse OP_INDEX_ADDR{} = 0
bciStackUse SWIZZLE{} = 0
bciStackUse BRK_FUN{} = 0
+bciStackUse HPC_TICK{} = 0
-- These insns actually reduce stack use, but we need the high-tide level,
-- so can't use this info. Not that it matters much.
=====================================
compiler/GHC/ByteCode/Types.hs
=====================================
@@ -25,6 +25,9 @@ module GHC.ByteCode.Types
-- * Mod Breaks
, ModBreaks (..), BreakpointId(..), BreakTickIndex
+ -- * Hpc Info
+ , ByteCodeHpcInfo(..)
+
-- * Internal Mod Breaks
, InternalModBreaks(..), CgBreakInfo(..), seqInternalModBreaks
-- ** Internal breakpoint identifier
@@ -35,6 +38,7 @@ import GHC.Prelude
import GHC.Data.FastString
import GHC.Data.FlatBag
+import qualified GHC.Data.Strict as Strict
import GHC.Types.Name
import GHC.Types.Name.Env
import GHC.Utils.Binary
@@ -79,6 +83,25 @@ data CompiledByteCode = CompiledByteCode
-- ^ Static pointer table entries which should be loaded along with the
-- BCOs. See Note [Grand plan for static forms] in
-- "GHC.Iface.Tidy.StaticPtrTable".
+
+ , bc_hpc_info :: !(Strict.Maybe ByteCodeHpcInfo)
+ -- ^ 'ByteCodeHpcInfo' that should be added to the run-time system when this 'CompiledByteCode'
+ -- object is loaded.
+ --
+ -- It is safe to load the same 'ByteCodeHpcInfo' multiple times.
+ }
+
+-- | ByteCode specific HPC information.
+--
+data ByteCodeHpcInfo = ByteCodeHpcInfo
+ { bchi_module_name :: !String
+ -- ^ Name of the module.
+ , bchi_tickbox_name :: !String
+ -- ^ Name of the tick box that has been added via 'CStub'.
+ , bchi_tick_count :: {-# UNPACK #-} !Int
+ -- ^ Number of ticks.
+ , bchi_hash :: {-# UNPACK #-} !Int
+ -- ^ mix-file hash.
}
-- | A libffi ffi_cif function prototype.
=====================================
compiler/GHC/Driver/Backend.hs
=====================================
@@ -712,8 +712,7 @@ backendSupportsHpc (Named NCG) = True
backendSupportsHpc (Named LLVM) = True
backendSupportsHpc (Named ViaC) = True
backendSupportsHpc (Named JavaScript) = False
--- TODO: @terrorjack thinks that the bytecode backend should support HPC now since (!13493)
-backendSupportsHpc (Named Bytecode) = False
+backendSupportsHpc (Named Bytecode) = True
backendSupportsHpc (Named NoBackend) = True
-- | This flag says whether the back end supports foreign
=====================================
compiler/GHC/Driver/CodeOutput.hs
=====================================
@@ -343,7 +343,6 @@ outputForeignStubs logger tmpfs dflags unit_state mod location stubs
cplusplus_hdr = "#if defined(__cplusplus)\nextern \"C\" {\n#endif\n"
cplusplus_ftr = "#if defined(__cplusplus)\n}\n#endif\n"
-
-- It is more than likely that the stubs file will
-- turn out to be empty, in which case no file should be created.
outputForeignStubs_help :: FilePath -> String -> String -> String -> IO Bool
=====================================
compiler/GHC/Driver/Main.hs
=====================================
@@ -134,6 +134,7 @@ import GHC.Driver.Config.Diagnostic
import GHC.Driver.Config.Tidy
import GHC.Driver.Hooks
import GHC.Driver.GenerateCgIPEStub (generateCgIPEStub, lookupEstimatedTicks)
+import GHC.Driver.Ppr (showSDoc)
import GHC.Runtime.Context
import GHC.Runtime.Interpreter
@@ -151,6 +152,7 @@ import GHC.Hs.Dump
import GHC.Hs.Stats ( ppSourceStats )
import GHC.HsToCore
+import GHC.HsToCore.Coverage ( hpcTickBoxes, hpcModuleName )
import GHC.StgToByteCode ( byteCodeGen )
import GHC.StgToJS ( stgToJS )
@@ -207,6 +209,8 @@ import qualified GHC.StgToCmm as StgToCmm ( codeGen )
import GHC.StgToCmm.Types (CmmCgInfos (..), ModuleLFInfos, LambdaFormInfo(..))
import GHC.StgToCmm.CgUtils (CgStream)
+import qualified GHC.ByteCode.Serialize as ByteCode
+
import GHC.Cmm
import GHC.Cmm.Info.Build
import GHC.Cmm.Pipeline
@@ -237,6 +241,7 @@ import GHC.Types.Var.Set
import GHC.Types.Error
import GHC.Types.Fixity.Env
import GHC.Types.CostCentre
+import GHC.Types.HpcInfo (HpcInfo (..))
import GHC.Types.IPE
import GHC.Types.SourceFile
import GHC.Types.SrcLoc
@@ -260,6 +265,7 @@ import GHC.Utils.Touch
import GHC.Data.FastString
import GHC.Data.Bag
import GHC.Data.OsPath (unsafeEncodeUtf)
+import qualified GHC.Data.Strict as Strict
import GHC.Data.StringBuffer
import qualified GHC.Data.Stream as Stream
import GHC.Data.Maybe
@@ -297,7 +303,6 @@ import GHC.Cmm.Config (CmmConfig)
import Data.Bifunctor
import qualified GHC.Unit.Home.Graph as HUG
import GHC.Unit.Home.PackageTable
-import qualified GHC.ByteCode.Serialize as ByteCode
{- **********************************************************************
%* *
@@ -1185,7 +1190,7 @@ compileWholeCoreBindings hsc_env type_env wcb = do
gen_bytecode core_binds stubs foreign_files = do
let cgi_guts = CgInteractiveGuts wcb_module core_binds
(typeEnvTyCons type_env) stubs foreign_files
- Nothing []
+ Nothing [] NoHpcInfo
trace_if logger (text "Generating ByteCode for" <+> ppr wcb_module)
mkModuleByteCode hsc_env wcb_module wcb_mod_location cgi_guts
@@ -2135,11 +2140,12 @@ data CgInteractiveGuts = CgInteractiveGuts { cgi_module :: Module
, cgi_foreign_files :: [(ForeignSrcLang, FilePath)]
, cgi_modBreaks :: Maybe ModBreaks
, cgi_spt_entries :: [SptEntry]
+ , cgi_hpc_info :: HpcInfo
}
mkCgInteractiveGuts :: CgGuts -> CgInteractiveGuts
-mkCgInteractiveGuts CgGuts{cg_module, cg_binds, cg_tycons, cg_foreign, cg_foreign_files, cg_modBreaks, cg_spt_entries}
- = CgInteractiveGuts cg_module cg_binds cg_tycons cg_foreign cg_foreign_files cg_modBreaks cg_spt_entries
+mkCgInteractiveGuts CgGuts{cg_module, cg_binds, cg_tycons, cg_foreign, cg_foreign_files, cg_modBreaks, cg_spt_entries, cg_hpc_info}
+ = CgInteractiveGuts cg_module cg_binds cg_tycons cg_foreign cg_foreign_files cg_modBreaks cg_spt_entries cg_hpc_info
hscInteractive :: HscEnv
-> CgInteractiveGuts
@@ -2162,13 +2168,15 @@ hscGenerateByteCode :: HscEnv -> CgInteractiveGuts -> ModLocation -> IO Compiled
hscGenerateByteCode hsc_env cgguts location = do
let dflags = hsc_dflags hsc_env
let logger = hsc_logger hsc_env
+ let platform = targetPlatform dflags
let CgInteractiveGuts{ -- This is the last use of the ModGuts in a compilation.
-- From now on, we just use the bits we need.
cgi_module = this_mod,
cgi_binds = core_binds,
cgi_tycons = tycons,
cgi_modBreaks = mod_breaks,
- cgi_spt_entries = spt_entries } = cgguts
+ cgi_spt_entries = spt_entries,
+ cgi_hpc_info = hpc_info } = cgguts
-------------------
-- ADD IMPLICIT BINDINGS
@@ -2193,8 +2201,22 @@ hscGenerateByteCode hsc_env cgguts location = do
let (stg_binds,_stg_deps) = unzip stg_binds_with_deps
+ -------------------
+ -- Setup HPC info
+ let
+ -- Strict to not retain a reference to the 'cgguts' via 'hpc_info'
+ !bytecodeHpcInfo = case hpc_info of
+ NoHpcInfo -> Strict.Nothing
+ HpcInfo{hpcInfoTickCount, hpcInfoHash} ->
+ Strict.Just ByteCodeHpcInfo
+ { bchi_tick_count = hpcInfoTickCount
+ , bchi_hash = hpcInfoHash
+ , bchi_tickboxes = showSDoc dflags $ hpcTickBoxes platform this_mod
+ , bchi_module_name = showSDoc dflags $ hpcModuleName this_mod
+ }
+
----------------- Generate byte code ------------------
- byteCodeGen hsc_env this_mod stg_binds tycons mod_breaks spt_entries
+ byteCodeGen hsc_env this_mod stg_binds tycons mod_breaks spt_entries bytecodeHpcInfo
-- | Generate a byte code object linkable and write it to a file if `-fwrite-byte-code` is enabled.
generateAndWriteByteCode :: HscEnv -> CgInteractiveGuts -> ModLocation -> IO ModuleByteCode
@@ -2843,6 +2865,7 @@ hscCompileCoreExpr' hsc_env srcspan ds_expr = do
[]
Nothing -- modbreaks
[] -- spt entries
+ Strict.Nothing -- no hpc info
{- load it -}
bco_time <- getCurrentTime
=====================================
compiler/GHC/Driver/Session.hs
=====================================
@@ -3791,12 +3791,6 @@ makeDynFlagsConsistent dflags
pgmError (backendDescription (backend dflags) ++
" supports only unregisterised ABI but target platform doesn't use it.")
- | gopt Opt_Hpc dflags && not (backendSupportsHpc (backend dflags))
- = let dflags' = gopt_unset dflags Opt_Hpc
- warn = "Hpc can't be used with " ++ backendDescription (backend dflags) ++
- ". Ignoring -fhpc."
- in loop dflags' warn
-
| backendSwappableWithViaC (backend dflags) &&
platformUnregisterised (targetPlatform dflags)
= loop (dflags { backend = viaCBackend })
=====================================
compiler/GHC/HsToCore.hs
=====================================
@@ -163,20 +163,20 @@ deSugar hsc_env
export_set (typeEnvTyCons type_env) binds
else return (binds, Nothing)
; let modBreaks
- | Just (_, specs) <- m_tickInfo
+ | Just (_, _, breakpointSpecs) <- m_tickInfo
, breakpointsAllowed dflags
- = Just $ mkModBreaks (interpreterProfiled $ hscInterp hsc_env) mod specs
+ = Just $ mkModBreaks (interpreterProfiled $ hscInterp hsc_env) mod breakpointSpecs
| otherwise
= Nothing
; ds_hpc_info <- case m_tickInfo of
- Just (orig_file2, ticks)
+ Just (orig_file2, hpcTicks, _)
| gopt Opt_Hpc $ hsc_dflags hsc_env
-> do
hashNo <- if gopt Opt_Hpc $ hsc_dflags hsc_env
- then writeMixEntries (hpcDir dflags) mod ticks orig_file2
+ then writeMixEntries (hpcDir dflags) mod hpcTicks orig_file2
else return 0 -- dummy hash when none are written
- pure $ HpcInfo (fromIntegral $ sizeSS ticks) hashNo
+ pure $ HpcInfo (fromIntegral $ sizeSS hpcTicks) hashNo
_ -> pure $ emptyHpcInfo
; (msgs, mb_res) <- initDs hsc_env tcg_env $
=====================================
compiler/GHC/HsToCore/Coverage.hs
=====================================
@@ -6,6 +6,9 @@
module GHC.HsToCore.Coverage
( writeMixEntries
, hpcInitCode
+ , hpcStubLabel
+ , hpcModuleName
+ , hpcTickBoxes
) where
import GHC.Prelude as Prelude
@@ -116,24 +119,33 @@ hpcInitCode _ _ (NoHpcInfo {}) = mempty
hpcInitCode platform this_mod (HpcInfo tickCount hashNo)
= initializerCStub platform fn_name decls body
where
- fn_name = mkInitializerStubLabel this_mod (fsLit "hpc")
+ fn_name = hpcStubLabel this_mod
decls = text "StgWord64 " <> tickboxes <> brackets (int tickCount) <> semi
body = text "hs_hpc_module" <>
parens (hcat (punctuate comma [
- doubleQuotes full_name_str,
+ doubleQuotes (hpcModuleName this_mod),
int tickCount, -- really StgWord32
int hashNo, -- really StgWord32
tickboxes
])) <> semi
+ tickboxes = hpcTickBoxes platform this_mod
- tickboxes = pprCLabel platform (mkHpcTicksLabel $ this_mod)
-
- module_name = hcat (map (text.charToC) $ BS.unpack $
- bytesFS (moduleNameFS (moduleName this_mod)))
- package_name = hcat (map (text.charToC) $ BS.unpack $
- bytesFS (unitFS (moduleUnit this_mod)))
- full_name_str
- | moduleUnit this_mod == mainUnit
- = module_name
- | otherwise
- = package_name <> char '/' <> module_name
+hpcStubLabel :: Module -> CLabel
+hpcStubLabel this_mod = mkInitializerStubLabel this_mod (fsLit "hpc")
+
+hpcModuleName :: Module -> SDoc
+hpcModuleName this_mod = full_name_str
+ where
+ full_name_str
+ | moduleUnit this_mod == mainUnit
+ = module_name
+ | otherwise
+ = package_name <> char '/' <> module_name
+ module_name = hcat (map (text.charToC) $ BS.unpack $
+ bytesFS (moduleNameFS (moduleName this_mod)))
+
+ package_name = hcat (map (text.charToC) $ BS.unpack $
+ bytesFS (unitFS (moduleUnit this_mod)))
+
+hpcTickBoxes :: Platform -> Module -> SDoc
+hpcTickBoxes platform this_mod = pprCLabel platform (mkHpcTicksLabel this_mod)
=====================================
compiler/GHC/HsToCore/Ticks.hs
=====================================
@@ -100,7 +100,7 @@ addTicksToBinds
-- hasn't set it), so we have to work from this set.
-> [TyCon] -- ^ Type constructors in this module
-> LHsBinds GhcTc
- -> IO (LHsBinds GhcTc, Maybe (FilePath, SizedSeq Tick))
+ -> IO (LHsBinds GhcTc, Maybe (FilePath, SizedSeq Tick, SizedSeq Tick))
addTicksToBinds logger cfg
mod mod_loc exports tyCons binds
@@ -133,12 +133,13 @@ addTicksToBinds logger cfg
(binds1,st) = foldr tickPass (binds, initTTState) passes
- extendedMixEntries = ticks st
+ hpcEntries = hpcTicks st
+ breakpointEntries = breakpointTicks st
putDumpFileMaybe logger Opt_D_dump_ticked "HPC" FormatHaskell
(pprLHsBinds binds1)
- return (binds1, Just (orig_file2, extendedMixEntries))
+ return (binds1, Just (orig_file2, hpcEntries, breakpointEntries))
| otherwise = return (binds, Nothing)
@@ -1050,23 +1051,31 @@ addTickArithSeqInfo (FromThenTo e1 e2 e3) =
(addTickLHsExpr e2)
(addTickLHsExpr e3)
-data TickTransState = TT { ticks :: !(SizedSeq Tick)
- , ccIndices :: !CostCentreState
- , recSelTicks :: !(IdEnv CoreTickish)
+data TickTransState = TT { hpcTicks :: !(SizedSeq Tick)
+ , breakpointTicks :: !(SizedSeq Tick)
+ , ccIndices :: !CostCentreState
+ , recSelTicks :: !(IdEnv CoreTickish)
}
initTTState :: TickTransState
-initTTState = TT { ticks = emptySS
- , ccIndices = newCostCentreState
- , recSelTicks = emptyVarEnv
+initTTState = TT { hpcTicks = emptySS
+ , breakpointTicks = emptySS
+ , ccIndices = newCostCentreState
+ , recSelTicks = emptyVarEnv
}
-addMixEntry :: Tick -> TM Int
-addMixEntry ent = do
- c <- fromIntegral . sizeSS . ticks <$> getState
+addHpcEntry :: Tick -> TM Int
+addHpcEntry ent = do
+ c <- fromIntegral . sizeSS . hpcTicks <$> getState
setState $ \st ->
- st { ticks = addToSS (ticks st) ent
- }
+ st { hpcTicks = addToSS (hpcTicks st) ent }
+ return c
+
+addBreakpointEntry :: Tick -> TM Int
+addBreakpointEntry ent = do
+ c <- fromIntegral . sizeSS . breakpointTicks <$> getState
+ setState $ \st ->
+ st { breakpointTicks = addToSS (breakpointTicks st) ent }
return c
addRecSelTick :: Id -> CoreTickish -> TM ()
@@ -1291,7 +1300,7 @@ mkTickish boxLabel countEntries topOnly pos fvs decl_path = do
env <- getEnv
case tickishType env of
- HpcTicks -> HpcTick (this_mod env) <$> addMixEntry me
+ HpcTicks -> HpcTick (this_mod env) <$> addHpcEntry me
ProfNotes -> do
flavour <- mkHpcCCFlavour <$> getCCIndexM cc_name
@@ -1300,7 +1309,7 @@ mkTickish boxLabel countEntries topOnly pos fvs decl_path = do
return $ ProfNote cc count True{-scopes-}
Breakpoints -> do
- i <- addMixEntry me
+ i <- addBreakpointEntry me
pure (Breakpoint noExtField (BreakpointId (this_mod env) i) ids)
SourceNotes | RealSrcSpan pos' _ <- pos ->
@@ -1325,19 +1334,19 @@ mkBinTickBoxHpc :: (Bool -> BoxLabel) -> SrcSpan -> LHsExpr GhcTc
mkBinTickBoxHpc boxLabel pos e = do
env <- getEnv
binTick <- HsBinTick
- <$> addMixEntry (Tick { tick_loc = pos
+ <$> addHpcEntry (Tick { tick_loc = pos
, tick_path = declPath env
, tick_ids = []
, tick_label = boxLabel True
})
- <*> addMixEntry (Tick { tick_loc = pos
+ <*> addHpcEntry (Tick { tick_loc = pos
, tick_path = declPath env
, tick_ids = []
, tick_label = boxLabel False
})
<*> pure e
tick <- HpcTick (this_mod env)
- <$> addMixEntry (Tick { tick_loc = pos
+ <$> addHpcEntry (Tick { tick_loc = pos
, tick_path = declPath env
, tick_ids = []
, tick_label = ExpBox False
=====================================
compiler/GHC/Iface/Tidy.hs
=====================================
@@ -402,6 +402,7 @@ tidyProgram opts (ModGuts { mg_module = mod
, mg_foreign_files = foreign_files
, mg_modBreaks = modBreaks
, mg_boot_exports = boot_exports
+ , mg_hpc_info = hpc_info
}) = do
(unfold_env, tidy_occ_env) <- chooseExternalIds opts mod tcs binds imp_rules
@@ -471,6 +472,7 @@ tidyProgram opts (ModGuts { mg_module = mod
, cg_dep_pkgs = S.map snd (dep_direct_pkgs deps)
, cg_modBreaks = modBreaks
, cg_spt_entries = spt_entries
+ , cg_hpc_info = hpc_info
}
, ModDetails { md_types = tidy_type_env
, md_rules = tidy_rules
=====================================
compiler/GHC/Linker/Loader.hs
=====================================
@@ -65,9 +65,10 @@ import GHCi.RemoteTypes
import GHC.Iface.Load
import GHCi.Message
+import GHC.ByteCode.Asm
import GHC.ByteCode.Breakpoints
import GHC.ByteCode.Linker
-import GHC.ByteCode.Asm
+import GHC.ByteCode.Serialize
import GHC.ByteCode.Types
import GHC.Linker.Unit (getUnitDepends)
@@ -97,8 +98,9 @@ import GHC.Unit.Module.Graph
import GHC.Unit.Module.ModIface
import GHC.Unit.State as Packages
-import qualified GHC.Data.ShortText as ST
import GHC.Data.FastString
+import qualified GHC.Data.ShortText as ST
+import qualified GHC.Data.Strict as Strict
import GHC.Linker.Deps
import GHC.Linker.MacOS
@@ -136,7 +138,6 @@ import qualified GHC.Runtime.Interpreter as GHCi
import qualified Data.IntMap.Strict as IM
import qualified Data.Map.Strict as M
import Foreign.Ptr (nullPtr)
-import GHC.ByteCode.Serialize
-- Note [Linkers and loaders]
-- ~~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -983,10 +984,9 @@ dynLinkBCOs interp pls keep_spec bcos =
let (bcos_loaded', new_bcos) = rmDupLinkables (bcos_loaded pls) bcos
pls1 = pls { bcos_loaded = bcos_loaded' }
- cbcs :: [CompiledByteCode]
- cbcs = concatMap linkableBCOs new_bcos
+ mbcs = concatMap linkableBCOs new_bcos
in do
- bco_state <- dynLinkCompiledByteCode interp (pkgs_loaded pls) (bco_loader_state pls) traverseHomePackageBytecodeState keep_spec cbcs
+ bco_state <- dynLinkCompiledByteCode interp (pkgs_loaded pls) (bco_loader_state pls) traverseHomePackageBytecodeState keep_spec mbcs
return $! pls1 { bco_loader_state = bco_state }
dynLinkCompiledByteCode :: Interp
@@ -996,22 +996,22 @@ dynLinkCompiledByteCode :: Interp
-> KeepModuleLinkableDefinitions
-> [CompiledByteCode]
-> IO BytecodeLoaderState
-dynLinkCompiledByteCode interp pkgs_loaded whole_bytecode_state traverse_bytecode_state keep_spec cbcs = do
+dynLinkCompiledByteCode interp pkgs_loaded whole_bytecode_state traverse_bytecode_state keep_spec mbcs = do
st1 <- traverse_bytecode_state whole_bytecode_state $ \bytecode_state -> do
let
le1 = bco_linker_env bytecode_state
lb1 = bco_linked_breaks bytecode_state
- ie2 <- linkITbls interp (itbl_env le1) (concatMap bc_itbls cbcs)
- ae2 <- foldlM (\env cbc -> allocateTopStrings interp (bc_strs cbc) env) (addr_env le1) cbcs
- be2 <- allocateBreakArrays interp (breakarray_env lb1) (catMaybes $ map bc_breaks cbcs)
- ce2 <- allocateCCS interp (ccs_env lb1) (catMaybes $ map bc_breaks cbcs)
+ ie2 <- linkITbls interp (itbl_env le1) (concatMap bc_itbls mbcs)
+ ae2 <- foldlM (\env cbc -> allocateTopStrings interp (bc_strs cbc) env) (addr_env le1) mbcs
+ be2 <- allocateBreakArrays interp (breakarray_env lb1) (catMaybes $ map bc_breaks mbcs)
+ ce2 <- allocateCCS interp (ccs_env lb1) (catMaybes $ map bc_breaks mbcs)
let le2 = le1 { itbl_env = ie2, addr_env = ae2 }
let lb2 = lb1 { breakarray_env = be2, ccs_env = ce2 }
return $! bytecode_state { bco_linker_env = le2, bco_linked_breaks = lb2 }
-- NB: Important to pass the whole bytecode loader state to linkSomeBCOs so that you can find Names in local
-- and external packages.
- names_and_refs <- linkSomeBCOs interp pkgs_loaded st1 cbcs
+ names_and_refs <- linkSomeBCOs interp pkgs_loaded st1 mbcs
-- We only want to add the external ones to the ClosureEnv
let (to_add, to_drop) = partition (keepDefinitions keep_spec . fst) names_and_refs
@@ -1024,7 +1024,9 @@ dynLinkCompiledByteCode interp pkgs_loaded whole_bytecode_state traverse_bytecod
traverse_bytecode_state st1 $ \bytecode_state -> do
let ce2 = extendClosureEnv (closure_env (bco_linker_env bytecode_state)) new_binds
-- Add SPT entries
- mapM_ (linkSptEntry interp ce2) (concatMap bc_spt_entries cbcs)
+ mapM_ (linkSptEntry interp ce2) (concatMap bc_spt_entries mbcs)
+ -- Load HPC modules
+ mapM_ (linkHpcEntry interp . bc_hpc_info) mbcs
return $! bytecode_state { bco_linker_env = (bco_linker_env bytecode_state) { closure_env = ce2 } }
-- | Register SPT entries for this module in the interpreter
@@ -1037,8 +1039,14 @@ linkSptEntry interp ce (SptEntry name fpr) = do
Nothing -> pprPanic "linkSptEntry" (ppr name)
Just (_, hval) -> addSptEntry interp fpr hval
-
-
+linkHpcEntry :: Interp -> Strict.Maybe ByteCodeHpcInfo -> IO ()
+linkHpcEntry _interp Strict.Nothing = pure ()
+linkHpcEntry interp (Strict.Just info) = do
+ addHpcModule interp
+ (bchi_module_name info)
+ (bchi_tick_count info)
+ (bchi_hash info)
+ (bchi_tickboxes info)
-- Link a bunch of BCOs and return references to their values
linkSomeBCOs :: Interp
=====================================
compiler/GHC/Linker/Types.hs
=====================================
@@ -214,36 +214,37 @@ data BytecodeLoaderState = BytecodeLoaderState
-- ^ Information about bytecode objects from the home package we have loaded into the interpreter.
, externalPackage_loaded :: BytecodeState
-- ^ Information about bytecode objects from external packages we have loaded into the interpreter.
+ , hpcInitialised :: !Bool
}
-- | Find a name loaded from bytecode
lookupNameBytecodeState :: BytecodeLoaderState -> Name -> Maybe (Name, ForeignHValue)
-lookupNameBytecodeState (BytecodeLoaderState home_package external_package) name = do
+lookupNameBytecodeState (BytecodeLoaderState home_package external_package _) name = do
lookupNameEnv (closure_env (bco_linker_env home_package)) name
<|> lookupNameEnv (closure_env (bco_linker_env external_package)) name
-- | Look up a break array in the bytecode loader state.
lookupBreakArrayBytecodeState :: BytecodeLoaderState -> Module -> Maybe (ForeignRef BreakArray)
-lookupBreakArrayBytecodeState (BytecodeLoaderState home_package external_package) break_mod = do
+lookupBreakArrayBytecodeState (BytecodeLoaderState home_package external_package _) break_mod = do
lookupModuleEnv (breakarray_env (bco_linked_breaks home_package)) break_mod
<|> lookupModuleEnv (breakarray_env (bco_linked_breaks external_package)) break_mod
-- | Look up an info table in the bytecode loader state.
lookupInfoTableBytecodeState :: BytecodeLoaderState -> Name -> Maybe (Name, ItblPtr)
-lookupInfoTableBytecodeState (BytecodeLoaderState home_package external_package) info_mod = do
+lookupInfoTableBytecodeState (BytecodeLoaderState home_package external_package _) info_mod = do
lookupNameEnv (itbl_env (bco_linker_env home_package)) info_mod
<|> lookupNameEnv (itbl_env (bco_linker_env external_package)) info_mod
-- | Look up an address in the bytecode loader state.
lookupAddressBytecodeState :: BytecodeLoaderState -> Name -> Maybe (Name, AddrPtr)
-lookupAddressBytecodeState (BytecodeLoaderState home_package external_package) addr_mod = do
+lookupAddressBytecodeState (BytecodeLoaderState home_package external_package _) addr_mod = do
lookupNameEnv (addr_env (bco_linker_env home_package)) addr_mod
<|> lookupNameEnv (addr_env (bco_linker_env external_package)) addr_mod
-- | Look up a cost centre stack in the bytecode loader state.
lookupCCSBytecodeState :: BytecodeLoaderState -> Module -> Maybe (Array BreakTickIndex (RemotePtr CostCentre))
-lookupCCSBytecodeState (BytecodeLoaderState home_package external_package) ccs_mod = do
+lookupCCSBytecodeState (BytecodeLoaderState home_package external_package _) ccs_mod = do
lookupModuleEnv (ccs_env (bco_linked_breaks home_package)) ccs_mod
<|> lookupModuleEnv (ccs_env (bco_linked_breaks external_package)) ccs_mod
@@ -251,6 +252,7 @@ emptyBytecodeLoaderState :: BytecodeLoaderState
emptyBytecodeLoaderState = BytecodeLoaderState
{ homePackage_loaded = emptyBytecodeState
, externalPackage_loaded = emptyBytecodeState
+ , hpcInitialised = False
}
emptyBytecodeState :: BytecodeState
=====================================
compiler/GHC/Runtime/Interpreter.hs
=====================================
@@ -17,6 +17,7 @@ module GHC.Runtime.Interpreter
, mallocData
, createBCOs
, addSptEntry
+ , addHpcModule
, mkCostCentres
, costCentreStackInfo
, newBreakArray
@@ -366,6 +367,10 @@ addSptEntry interp fpr ref =
withForeignRef ref $ \val ->
interpCmd interp (AddSptEntry fpr val)
+addHpcModule :: Interp -> String -> Int -> Int -> String -> IO ()
+addHpcModule interp modLabel tickNo hash tickboxes =
+ interpCmd interp (AddHpcModule modLabel tickNo hash tickboxes)
+
costCentreStackInfo :: Interp -> RemotePtr CostCentreStack -> IO [String]
costCentreStackInfo interp ccs =
interpCmd interp (CostCentreStackInfo ccs)
=====================================
compiler/GHC/StgToByteCode.hs
=====================================
@@ -20,6 +20,7 @@ import GHC.ByteCode.Types
import GHC.Cmm.CallConv
import GHC.Cmm.Expr
+import GHC.Cmm.CLabel (mkHpcTicksLabel, pprCLabel)
import GHC.Cmm.Reg ( GlobalArgRegs(..) )
import GHC.Cmm.Node
import GHC.Cmm.Utils
@@ -97,6 +98,7 @@ import Control.Monad.IO.Class
import Control.Monad.Trans.Reader (ReaderT(..))
import Control.Monad.Trans.State (StateT(..))
import Data.Bifunctor (Bifunctor(..))
+import qualified GHC.Data.Strict as Strict
-- -----------------------------------------------------------------------------
-- Generating byte code for a complete module
@@ -107,8 +109,9 @@ byteCodeGen :: HscEnv
-> [TyCon]
-> Maybe ModBreaks
-> [SptEntry]
+ -> Strict.Maybe ByteCodeHpcInfo
-> IO CompiledByteCode
-byteCodeGen hsc_env this_mod binds tycs mb_modBreaks spt_entries
+byteCodeGen hsc_env this_mod binds tycs mb_modBreaks spt_entries hpc_info
= withTiming logger
(text "GHC.StgToByteCode"<+>brackets (ppr this_mod))
(const ()) $ do
@@ -134,7 +137,7 @@ byteCodeGen hsc_env this_mod binds tycs mb_modBreaks spt_entries
let mod_breaks = case mb_modBreaks of
Nothing -> Nothing
Just mb -> Just $ mkInternalModBreaks this_mod breakInfo mb
- cbc <- assembleBCOs profile proto_bcos tycs strings mod_breaks spt_entries
+ cbc <- assembleBCOs profile proto_bcos tycs strings mod_breaks spt_entries hpc_info
-- Squash space leaks in the CompiledByteCode. This is really
-- important, because when loading a set of modules into GHCi
@@ -604,6 +607,11 @@ schemeE _d _s _p (StgTick (Breakpoint _ bp_id _) _rhs)
= pprPanic "schemeE: Breakpoint without let binding:"
(ppr bp_id <+> text "forgot to run bcPrep?")
+schemeE d s p (StgTick (HpcTick mod ix) rhs) = do
+ platform <- profilePlatform <$> getProfile
+ rhs_code <- schemeE d s p rhs
+ pure (unitOL (HPC_TICK (mkHpcTickLabel platform mod) (fromIntegral ix)) `appOL` rhs_code)
+
-- ignore other kinds of tick
schemeE d s p (StgTick _ rhs) = schemeE d s p rhs
@@ -2784,6 +2792,10 @@ getLastBreakTick = BcM $ \env st ->
tickFS :: FastString
tickFS = fsLit "ticked"
+mkHpcTickLabel :: Platform -> Module -> FastString
+mkHpcTickLabel platform mod =
+ fsLit (showSDocOneLine defaultSDocContext (pprCLabel platform (mkHpcTicksLabel mod)))
+
-- Dehydrating CgBreakInfo
dehydrateCgBreakInfo :: [TyVar] -> [Maybe (Id, Word)] -> Type -> Either InternalBreakLoc BreakpointId -> CgBreakInfo
=====================================
compiler/GHC/Types/HpcInfo.hs
=====================================
@@ -18,4 +18,3 @@ data HpcInfo
emptyHpcInfo :: HpcInfo
emptyHpcInfo = NoHpcInfo
-
=====================================
compiler/GHC/Unit/Module/ModGuts.hs
=====================================
@@ -141,8 +141,9 @@ data CgGuts
cg_dep_pkgs :: !(Set UnitId), -- ^ Dependent packages, used to
-- generate #includes for C code gen
cg_modBreaks :: !(Maybe ModBreaks), -- ^ Module breakpoints
- cg_spt_entries :: [SptEntry]
+ cg_spt_entries :: [SptEntry],
-- ^ Static pointer table entries for static forms defined in
-- the module.
-- See Note [Grand plan for static forms] in "GHC.Iface.Tidy.StaticPtrTable"
+ cg_hpc_info :: HpcInfo
}
=====================================
libraries/ghci/GHCi/Coverage.hs
=====================================
@@ -0,0 +1,51 @@
+{-# LANGUAGE ForeignFunctionInterface #-}
+{-# LANGUAGE LambdaCase #-}
+
+module GHCi.Coverage (
+ hpcAddModule,
+ ) where
+
+import Prelude -- See note [Why do we import Prelude here?]
+
+import Control.Exception
+import qualified Data.ByteString.Char8 as BS8
+import qualified Data.ByteString.Unsafe as B
+import Data.Word
+import Foreign
+import Foreign.C.String (withCAString)
+import GHC.Fingerprint
+import GHC.Foreign (CString)
+import GHCi.ObjLink (lookupSymbol)
+
+-- | Inform the run-time system that the given module name is instrumented via @hpc@
+-- and to collect @.tix@ info.
+--
+-- Starts the `hpc` run-time if it hasn't already been started.
+hpcAddModule ::
+ String ->
+ -- ^ Name of the module to instrument
+ Int ->
+ -- ^ Number of hpc ticks in this module
+ Int ->
+ -- ^ 'HpcInfo's 'hpcInfoHash'
+ String ->
+ -- ^ Name of the ticks array found in the c-stub.
+ IO ()
+hpcAddModule modlName ticks hash tickboxes = do
+ withCAString modlName $ \modlNameLiteral -> do
+ -- we need to find the reference to the ticks array.
+ lookupSymbol tickboxes >>= \ case
+ Nothing -> do
+ -- the symbol is not found, this is a bug!
+ throwIO $ ErrorCall $ "hpcAddModule: failed to find symbol " <> tickboxes
+ Just tickBoxRef -> do
+ -- Calling 'hs_hpc_module' multiple times is safe, it will add the module only once.
+ hpc_register_module modlNameLiteral (fromIntegral ticks) (fromIntegral hash) (castPtr tickBoxRef)
+ -- calling 'hpc_startup' multiple times is safe, it will only be initialised once.
+ hpc_startup
+
+foreign import ccall "hs_hpc_module"
+ hpc_register_module :: CString -> Word32 -> Word32 -> Ptr Word64 -> IO ()
+
+foreign import ccall "startupHpc"
+ hpc_startup :: IO ()
=====================================
libraries/ghci/GHCi/Message.hs
=====================================
@@ -111,6 +111,8 @@ data Message a where
-- | Add entries to the Static Pointer Table
AddSptEntry :: Fingerprint -> HValueRef -> Message ()
+ -- | Add module to hpc
+ AddHpcModule :: String -> Int -> Int -> String -> Message ()
-- | Malloc some data and return a 'RemotePtr' to it
MallocData :: ByteString -> Message (RemotePtr ())
@@ -607,7 +609,8 @@ getMessage = do
38 -> Msg <$> (ResumeSeq <$> get)
39 -> Msg <$> (LookupSymbolInDLL <$> get <*> get)
40 -> Msg <$> (WhereFrom <$> get)
- 41 -> Msg <$> (CustomMessage <$> get <*> get)
+ 41 -> Msg <$> (AddHpcModule <$> get <*> get <*> get <*> get)
+ 42 -> Msg <$> (CustomMessage <$> get <*> get)
_ -> error $ "Unknown Message code " ++ (show b)
putMessage :: Message a -> Put
@@ -654,7 +657,8 @@ putMessage m = case m of
ResumeSeq a -> putWord8 38 >> put a
LookupSymbolInDLL dll str -> putWord8 39 >> put dll >> put str
WhereFrom a -> putWord8 40 >> put a
- CustomMessage tag payload -> putWord8 41 >> put tag >> put payload
+ AddHpcModule m n h ticks -> putWord8 41 >> put m >> put n >> put h >> put ticks
+ CustomMessage tag payload -> putWord8 42 >> put tag >> put payload
{-
Note [Parallelize CreateBCOs serialization]
=====================================
libraries/ghci/GHCi/Run.hs
=====================================
@@ -19,6 +19,7 @@ import GHCi.CreateBCO
import GHCi.InfoTable
#endif
+import GHCi.Coverage
import qualified GHC.InfoProv as InfoProv
import GHCi.Debugger
import GHCi.FFI
@@ -88,6 +89,7 @@ run m = case m of
fmap toRemotePtr <$> lookupSymbolInDLL (fromRemotePtr dll) str
FreeHValueRefs rs -> mapM_ freeRemoteRef rs
AddSptEntry fpr r -> localRef r >>= sptAddEntry fpr
+ AddHpcModule modl ticks hash tickboxes -> hpcAddModule modl ticks hash tickboxes
EvalStmt opts r -> evalStmt opts r
ResumeStmt opts r -> resumeStmt opts r
AbandonStmt r -> abandonStmt r
=====================================
libraries/ghci/ghci.cabal.in
=====================================
@@ -59,6 +59,7 @@ library
if flag(internal-interpreter)
CPP-Options: -DHAVE_INTERNAL_INTERPRETER
exposed-modules:
+ GHCi.Coverage
GHCi.Run
GHCi.Debugger
GHCi.CreateBCO
=====================================
rts/Disassembler.c
=====================================
@@ -101,6 +101,13 @@ disInstr ( StgBCO *bco, int pc )
}
debugBelch("\n");
break; }
+ case bci_HPC_TICK: {
+ W_ p1, info_wix;
+ p1 = BCO_GET_LARGE_ARG;
+ info_wix = BCO_READ_NEXT_32;
+ debugBelch("HPC_TICK "); printPtr((StgPtr)literals[p1]);
+ debugBelch(" %" FMT_Word "\n", info_wix);
+ break; }
case bci_SWIZZLE: {
W_ stkoff = BCO_GET_LARGE_ARG;
StgInt by = BCO_GET_LARGE_ARG;
=====================================
rts/Hpc.c
=====================================
@@ -270,6 +270,9 @@ hs_hpc_module(char *modName,
HpcModuleInfo *tmpModule;
uint32_t i;
+ debugTrace(DEBUG_hpc, "hs_hpc_module(%s, count=%u, hash=%u)\n",
+ modName, modCount, modHashNo);
+
if (moduleHash == NULL) {
moduleHash = allocStrHashTable();
}
=====================================
rts/Interpreter.c
=====================================
@@ -1711,7 +1711,7 @@ run_BCO:
&&lbl_bci_TESTEQ_W8 - &&lbl_bci_DEFAULT,
&&lbl_bci_PRIMCALL - &&lbl_bci_DEFAULT,
&&lbl_bci_BCO_NAME - &&lbl_bci_DEFAULT,
- &&lbl_bci_DEFAULT - &&lbl_bci_DEFAULT,
+ &&lbl_bci_HPC_TICK - &&lbl_bci_DEFAULT,
&&lbl_bci_OP_ADD_64 - &&lbl_bci_DEFAULT,
&&lbl_bci_OP_SUB_64 - &&lbl_bci_DEFAULT,
&&lbl_bci_OP_AND_64 - &&lbl_bci_DEFAULT,
@@ -2078,6 +2078,18 @@ run_BCO:
NEXT_INSTRUCTION;
}
+ INSTRUCTION(bci_HPC_TICK): {
+ W_ arg1_ticks_array, arg2_tick_index;
+ arg1_ticks_array = BCO_GET_LARGE_ARG;
+ arg2_tick_index = BCO_READ_NEXT_32;
+ IF_DEBUG(hpc,
+ debugBelch("\tHPC Tick %lu %lu %lu\n", BCO_LIT(arg1_ticks_array), arg1_ticks_array, arg2_tick_index);
+ );
+
+ ((StgWord64*)BCO_LIT(arg1_ticks_array))[arg2_tick_index]++;
+ NEXT_INSTRUCTION;
+ }
+
INSTRUCTION(bci_STKCHECK): {
// Explicit stack check at the beginning of a function
// *only* (stack checks in case alternatives are
=====================================
rts/include/rts/Bytecodes.h
=====================================
@@ -118,6 +118,7 @@
#define bci_PRIMCALL 87
#define bci_BCO_NAME 88
+#define bci_HPC_TICK 89
#define bci_OP_ADD_64 90
#define bci_OP_SUB_64 91
=====================================
testsuite/tests/hpc/ghc_ghci/BytecodeMain.hs
=====================================
@@ -0,0 +1,10 @@
+module Main where
+
+inc :: Int -> Int
+inc x = x + 1
+
+double :: Int -> Int
+double x = x * 2
+
+main :: IO ()
+main = print (double (inc 1011))
=====================================
testsuite/tests/hpc/ghc_ghci/Makefile
=====================================
@@ -7,3 +7,9 @@ hpc_ghc_ghci:
'$(TEST_HC)' $(TEST_HC_OPTS) -fhpc -c A.hs
echo b | '$(TEST_HC)' $(TEST_HC_OPTS_INTERACTIVE) B.hs
+hpc_ghc_ghci_bytecode:
+ rm -f ./*.tix
+ printf "main\n:quit\n" | '$(TEST_HC)' $(TEST_HC_OPTS_INTERACTIVE) -fhpc -fbyte-code-and-object-code -fprefer-byte-code BytecodeMain.hs
+ @[ -f .hpc/Main.mix ] || (echo "ERROR: Expected .hpc/Main.mix file not found"; exit 1)
+ @set -- ./*.tix; [ -f "$$1" ] || (echo "ERROR: Expected .tix file not found"; exit 1); '$(HPC)' report "$$1" Main > hpc-report.txt
+ @grep -F "100% expressions used" hpc-report.txt >/dev/null || (echo "ERROR: Expected full expression coverage in hpc report"; cat hpc-report.txt; exit 1)
=====================================
testsuite/tests/hpc/ghc_ghci/hpc_ghc_ghci_bytecode.stdout
=====================================
@@ -0,0 +1 @@
+2024
=====================================
testsuite/tests/hpc/ghc_ghci/test.T
=====================================
@@ -3,3 +3,8 @@ test('hpc_ghc_ghci',
[extra_files(['A.hs', 'B.hs']),
only_ways(['normal']), when(compiler_profiled(), skip), req_interp],
run_command, ['$MAKE -s --no-print-directory hpc_ghc_ghci'])
+
+test('hpc_ghc_ghci_bytecode',
+ [extra_files(['BytecodeMain.hs']),
+ only_ways(['normal']), when(compiler_profiled(), skip), req_interp],
+ run_command, ['$MAKE -s --no-print-directory hpc_ghc_ghci_bytecode'])
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/51d6c6586ae6f598653e064b3f10394…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/51d6c6586ae6f598653e064b3f10394…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/fendor/hpc-bc-support] Make HPC work with bytecode interpreter
by Hannes Siebenhandl (＠fendor) 02 Apr '26
by Hannes Siebenhandl (＠fendor) 02 Apr '26
02 Apr '26
Hannes Siebenhandl pushed to branch wip/fendor/hpc-bc-support at Glasgow Haskell Compiler / GHC
Commits:
467794d8 by fendor at 2026-04-02T10:58:54+02:00
Make HPC work with bytecode interpreter
Add support to generate .tix files from bytecode objects and the
bytecode interpreter.
Conceptually, we insert HPC ticks into the bytecode similar to how we insert
breakpoints.
HPC and breakpoints do not share the same tick array but we use a separate
tick-array for hpc/breakpoint ticks during bytecode generation.
We teach the bytecode interpreter to handle hpc ticks.
The implementation is quite trivial, simply increment the counter in the
global hpc_ticks array for the respective module.
This hpc_ticks array is generated as part of the `CStub`, so we can rely
on it existing.
A tricky bit is "registering" a bytecode object for HPC instrumentation.
In the compiled case, this is achieved via CStub and initializer/finalizers
`.init` sections which are called when the executable is run.
After the initializers have been invoked, which is before `hs_init_ghc`,
we then call `startup_hpc` in `hs_init_ghc` iff any modules were "registered"
for hpc instrumentation via `hs_hpc_module`.
Since bytecode objects are loaded after starting up GHCi, this workflow
doesn't work for supporting `hpc` and the `hpc` run-time is never
started, even if a module is added for instrumentation.
We fix this issue by employing the same technique as is for `SptEntry`s:
* We introduce a new field to `CompiledByteCode`, called `ByteCodeHpcInfo`
which contains enough information to call `hs_hpc_module`, allowing us to
register the module for `hpc` instrumentation`.
* After registering the module, we unconditionally call `startupHpc`, to make
sure the .tix file is written.
Calling `startupHpc` multiple times is safe.
Calling `hs_hpc_module` multiple times for the same module is also safe.
Evaluating a bytecode object instrumented with `-fhpc` without registering it
in the `hpc` run-time will simply not generate any `.tix` files for this
bytecode object.
Closes #27036
- - - - -
29 changed files:
- compiler/GHC/ByteCode/Asm.hs
- compiler/GHC/ByteCode/Instr.hs
- compiler/GHC/ByteCode/Types.hs
- compiler/GHC/Driver/Backend.hs
- compiler/GHC/Driver/CodeOutput.hs
- compiler/GHC/Driver/Main.hs
- compiler/GHC/Driver/Session.hs
- compiler/GHC/HsToCore.hs
- compiler/GHC/HsToCore/Coverage.hs
- compiler/GHC/HsToCore/Ticks.hs
- compiler/GHC/Iface/Tidy.hs
- compiler/GHC/Linker/Loader.hs
- compiler/GHC/Linker/Types.hs
- compiler/GHC/Runtime/Interpreter.hs
- compiler/GHC/StgToByteCode.hs
- compiler/GHC/Types/HpcInfo.hs
- compiler/GHC/Unit/Module/ModGuts.hs
- + libraries/ghci/GHCi/Coverage.hs
- libraries/ghci/GHCi/Message.hs
- libraries/ghci/GHCi/Run.hs
- libraries/ghci/ghci.cabal.in
- rts/Disassembler.c
- rts/Hpc.c
- rts/Interpreter.c
- rts/include/rts/Bytecodes.h
- + testsuite/tests/hpc/ghc_ghci/BytecodeMain.hs
- testsuite/tests/hpc/ghc_ghci/Makefile
- + testsuite/tests/hpc/ghc_ghci/hpc_ghc_ghci_bytecode.stdout
- testsuite/tests/hpc/ghc_ghci/test.T
Changes:
=====================================
compiler/GHC/ByteCode/Asm.hs
=====================================
@@ -72,6 +72,7 @@ import GHC.Float (castFloatToWord32, castDoubleToWord64)
import qualified Data.List as List ( any )
import GHC.Exts
+import qualified GHC.Data.Strict as Strict
-- -----------------------------------------------------------------------------
@@ -111,8 +112,9 @@ assembleBCOs
-> [(Name, ByteString)]
-> Maybe InternalModBreaks
-> [SptEntry]
+ -> Strict.Maybe ByteCodeHpcInfo
-> IO CompiledByteCode
-assembleBCOs profile proto_bcos tycons top_strs modbreaks spt_entries = do
+assembleBCOs profile proto_bcos tycons top_strs modbreaks spt_entries use_hpc = do
-- TODO: the profile should be bundled with the interpreter: the rts ways are
-- fixed for an interpreter
let itbls = mkITbls profile tycons
@@ -123,6 +125,7 @@ assembleBCOs profile proto_bcos tycons top_strs modbreaks spt_entries = do
, bc_strs = top_strs
, bc_breaks = modbreaks
, bc_spt_entries = spt_entries
+ , bc_hpc_info = use_hpc
}
-- Note [Allocating string literals]
@@ -856,6 +859,12 @@ assembleI platform i = case i of
emit_ bci_BRK_FUN [ Op p1, Op info_addr, Op info_unitid_addr
, SmallOp ix_hi, SmallOp ix_lo, Op np ]
+ HPC_TICK lbl ix -> do
+ p <- lit1 (BCONPtrLbl lbl)
+ let ix_hi = fromIntegral (ix `shiftR` 16)
+ ix_lo = fromIntegral (ix .&. 0xffff)
+ emit_ bci_HPC_TICK [Op p, SmallOp ix_hi, SmallOp ix_lo]
+
#if MIN_VERSION_rts(1,0,3)
BCO_NAME name -> do np <- lit1 (BCONPtrStr name)
emit_ bci_BCO_NAME [Op np]
=====================================
compiler/GHC/ByteCode/Instr.hs
=====================================
@@ -15,6 +15,7 @@ import GHC.ByteCode.Types
import GHC.Cmm.Type (Width)
import GHC.StgToCmm.Layout ( ArgRep(..) )
import GHC.Utils.Outputable
+import GHC.Data.FastString ( FastString )
import GHC.Types.Name
import GHC.Types.Literal
import GHC.Types.Unique
@@ -257,6 +258,7 @@ data BCInstr
-- Breakpoints
| BRK_FUN !InternalBreakpointId
+ | HPC_TICK !FastString !Word32
#if MIN_VERSION_rts(1,0,3)
-- | A "meta"-instruction for recording the name of a BCO for debugging purposes.
@@ -452,6 +454,7 @@ instance Outputable BCInstr where
= text "BRK_FUN" <+> text "<breakarray>"
<+> ppr info_mod <+> ppr infox
<+> text "<cc>"
+ ppr (HPC_TICK lbl ix) = text "HPC_TICK" <+> ppr lbl <+> ppr ix
#if MIN_VERSION_rts(1,0,3)
ppr (BCO_NAME nm) = text "BCO_NAME" <+> text (show nm)
#endif
@@ -578,6 +581,7 @@ bciStackUse OP_INDEX_ADDR{} = 0
bciStackUse SWIZZLE{} = 0
bciStackUse BRK_FUN{} = 0
+bciStackUse HPC_TICK{} = 0
-- These insns actually reduce stack use, but we need the high-tide level,
-- so can't use this info. Not that it matters much.
=====================================
compiler/GHC/ByteCode/Types.hs
=====================================
@@ -25,6 +25,9 @@ module GHC.ByteCode.Types
-- * Mod Breaks
, ModBreaks (..), BreakpointId(..), BreakTickIndex
+ -- * Hpc Info
+ , ByteCodeHpcInfo(..)
+
-- * Internal Mod Breaks
, InternalModBreaks(..), CgBreakInfo(..), seqInternalModBreaks
-- ** Internal breakpoint identifier
@@ -35,6 +38,7 @@ import GHC.Prelude
import GHC.Data.FastString
import GHC.Data.FlatBag
+import qualified GHC.Data.Strict as Strict
import GHC.Types.Name
import GHC.Types.Name.Env
import GHC.Utils.Binary
@@ -79,6 +83,25 @@ data CompiledByteCode = CompiledByteCode
-- ^ Static pointer table entries which should be loaded along with the
-- BCOs. See Note [Grand plan for static forms] in
-- "GHC.Iface.Tidy.StaticPtrTable".
+
+ , bc_hpc_info :: !(Strict.Maybe ByteCodeHpcInfo)
+ -- ^ 'ByteCodeHpcInfo' that should be added to the run-time system when this 'CompiledByteCode'
+ -- object is loaded.
+ --
+ -- It is safe to load the same 'ByteCodeHpcInfo' multiple times.
+ }
+
+-- | ByteCode specific HPC information.
+--
+data ByteCodeHpcInfo = ByteCodeHpcInfo
+ { bchi_module_name :: !String
+ -- ^ Name of the module.
+ , bchi_tickbox_name :: !String
+ -- ^ Name of the tick box that has been added via 'CStub'.
+ , bchi_tick_count :: {-# UNPACK #-} !Int
+ -- ^ Number of ticks.
+ , bchi_hash :: {-# UNPACK #-} !Int
+ -- ^ mix-file hash.
}
-- | A libffi ffi_cif function prototype.
=====================================
compiler/GHC/Driver/Backend.hs
=====================================
@@ -712,8 +712,7 @@ backendSupportsHpc (Named NCG) = True
backendSupportsHpc (Named LLVM) = True
backendSupportsHpc (Named ViaC) = True
backendSupportsHpc (Named JavaScript) = False
--- TODO: @terrorjack thinks that the bytecode backend should support HPC now since (!13493)
-backendSupportsHpc (Named Bytecode) = False
+backendSupportsHpc (Named Bytecode) = True
backendSupportsHpc (Named NoBackend) = True
-- | This flag says whether the back end supports foreign
=====================================
compiler/GHC/Driver/CodeOutput.hs
=====================================
@@ -343,7 +343,6 @@ outputForeignStubs logger tmpfs dflags unit_state mod location stubs
cplusplus_hdr = "#if defined(__cplusplus)\nextern \"C\" {\n#endif\n"
cplusplus_ftr = "#if defined(__cplusplus)\n}\n#endif\n"
-
-- It is more than likely that the stubs file will
-- turn out to be empty, in which case no file should be created.
outputForeignStubs_help :: FilePath -> String -> String -> String -> IO Bool
=====================================
compiler/GHC/Driver/Main.hs
=====================================
@@ -134,6 +134,7 @@ import GHC.Driver.Config.Diagnostic
import GHC.Driver.Config.Tidy
import GHC.Driver.Hooks
import GHC.Driver.GenerateCgIPEStub (generateCgIPEStub, lookupEstimatedTicks)
+import GHC.Driver.Ppr (showSDoc)
import GHC.Runtime.Context
import GHC.Runtime.Interpreter
@@ -151,6 +152,7 @@ import GHC.Hs.Dump
import GHC.Hs.Stats ( ppSourceStats )
import GHC.HsToCore
+import GHC.HsToCore.Coverage ( hpcTickBoxes, hpcModuleName )
import GHC.StgToByteCode ( byteCodeGen )
import GHC.StgToJS ( stgToJS )
@@ -207,6 +209,8 @@ import qualified GHC.StgToCmm as StgToCmm ( codeGen )
import GHC.StgToCmm.Types (CmmCgInfos (..), ModuleLFInfos, LambdaFormInfo(..))
import GHC.StgToCmm.CgUtils (CgStream)
+import qualified GHC.ByteCode.Serialize as ByteCode
+
import GHC.Cmm
import GHC.Cmm.Info.Build
import GHC.Cmm.Pipeline
@@ -237,6 +241,7 @@ import GHC.Types.Var.Set
import GHC.Types.Error
import GHC.Types.Fixity.Env
import GHC.Types.CostCentre
+import GHC.Types.HpcInfo (HpcInfo (..))
import GHC.Types.IPE
import GHC.Types.SourceFile
import GHC.Types.SrcLoc
@@ -260,6 +265,7 @@ import GHC.Utils.Touch
import GHC.Data.FastString
import GHC.Data.Bag
import GHC.Data.OsPath (unsafeEncodeUtf)
+import qualified GHC.Data.Strict as Strict
import GHC.Data.StringBuffer
import qualified GHC.Data.Stream as Stream
import GHC.Data.Maybe
@@ -297,7 +303,6 @@ import GHC.Cmm.Config (CmmConfig)
import Data.Bifunctor
import qualified GHC.Unit.Home.Graph as HUG
import GHC.Unit.Home.PackageTable
-import qualified GHC.ByteCode.Serialize as ByteCode
{- **********************************************************************
%* *
@@ -1185,7 +1190,7 @@ compileWholeCoreBindings hsc_env type_env wcb = do
gen_bytecode core_binds stubs foreign_files = do
let cgi_guts = CgInteractiveGuts wcb_module core_binds
(typeEnvTyCons type_env) stubs foreign_files
- Nothing []
+ Nothing [] NoHpcInfo
trace_if logger (text "Generating ByteCode for" <+> ppr wcb_module)
mkModuleByteCode hsc_env wcb_module wcb_mod_location cgi_guts
@@ -2135,11 +2140,12 @@ data CgInteractiveGuts = CgInteractiveGuts { cgi_module :: Module
, cgi_foreign_files :: [(ForeignSrcLang, FilePath)]
, cgi_modBreaks :: Maybe ModBreaks
, cgi_spt_entries :: [SptEntry]
+ , cgi_hpc_info :: HpcInfo
}
mkCgInteractiveGuts :: CgGuts -> CgInteractiveGuts
-mkCgInteractiveGuts CgGuts{cg_module, cg_binds, cg_tycons, cg_foreign, cg_foreign_files, cg_modBreaks, cg_spt_entries}
- = CgInteractiveGuts cg_module cg_binds cg_tycons cg_foreign cg_foreign_files cg_modBreaks cg_spt_entries
+mkCgInteractiveGuts CgGuts{cg_module, cg_binds, cg_tycons, cg_foreign, cg_foreign_files, cg_modBreaks, cg_spt_entries, cg_hpc_info}
+ = CgInteractiveGuts cg_module cg_binds cg_tycons cg_foreign cg_foreign_files cg_modBreaks cg_spt_entries cg_hpc_info
hscInteractive :: HscEnv
-> CgInteractiveGuts
@@ -2162,13 +2168,15 @@ hscGenerateByteCode :: HscEnv -> CgInteractiveGuts -> ModLocation -> IO Compiled
hscGenerateByteCode hsc_env cgguts location = do
let dflags = hsc_dflags hsc_env
let logger = hsc_logger hsc_env
+ let platform = targetPlatform dflags
let CgInteractiveGuts{ -- This is the last use of the ModGuts in a compilation.
-- From now on, we just use the bits we need.
cgi_module = this_mod,
cgi_binds = core_binds,
cgi_tycons = tycons,
cgi_modBreaks = mod_breaks,
- cgi_spt_entries = spt_entries } = cgguts
+ cgi_spt_entries = spt_entries,
+ cgi_hpc_info = hpc_info } = cgguts
-------------------
-- ADD IMPLICIT BINDINGS
@@ -2193,8 +2201,22 @@ hscGenerateByteCode hsc_env cgguts location = do
let (stg_binds,_stg_deps) = unzip stg_binds_with_deps
+ -------------------
+ -- Setup HPC info
+ let
+ -- Strict to not retain a reference to the 'cgguts' via 'hpc_info'
+ !bytecodeHpcInfo = case hpc_info of
+ NoHpcInfo -> Strict.Nothing
+ HpcInfo{hpcInfoTickCount, hpcInfoHash} ->
+ Strict.Just ByteCodeHpcInfo
+ { bchi_tick_count = hpcInfoTickCount
+ , bchi_hash = hpcInfoHash
+ , bchi_tickboxes = showSDoc dflags $ hpcTickBoxes platform this_mod
+ , bchi_module_name = showSDoc dflags $ hpcModuleName this_mod
+ }
+
----------------- Generate byte code ------------------
- byteCodeGen hsc_env this_mod stg_binds tycons mod_breaks spt_entries
+ byteCodeGen hsc_env this_mod stg_binds tycons mod_breaks spt_entries bytecodeHpcInfo
-- | Generate a byte code object linkable and write it to a file if `-fwrite-byte-code` is enabled.
generateAndWriteByteCode :: HscEnv -> CgInteractiveGuts -> ModLocation -> IO ModuleByteCode
@@ -2843,6 +2865,7 @@ hscCompileCoreExpr' hsc_env srcspan ds_expr = do
[]
Nothing -- modbreaks
[] -- spt entries
+ Strict.Nothing -- no hpc info
{- load it -}
bco_time <- getCurrentTime
=====================================
compiler/GHC/Driver/Session.hs
=====================================
@@ -3791,12 +3791,6 @@ makeDynFlagsConsistent dflags
pgmError (backendDescription (backend dflags) ++
" supports only unregisterised ABI but target platform doesn't use it.")
- | gopt Opt_Hpc dflags && not (backendSupportsHpc (backend dflags))
- = let dflags' = gopt_unset dflags Opt_Hpc
- warn = "Hpc can't be used with " ++ backendDescription (backend dflags) ++
- ". Ignoring -fhpc."
- in loop dflags' warn
-
| backendSwappableWithViaC (backend dflags) &&
platformUnregisterised (targetPlatform dflags)
= loop (dflags { backend = viaCBackend })
=====================================
compiler/GHC/HsToCore.hs
=====================================
@@ -163,20 +163,20 @@ deSugar hsc_env
export_set (typeEnvTyCons type_env) binds
else return (binds, Nothing)
; let modBreaks
- | Just (_, specs) <- m_tickInfo
+ | Just (_, _, breakpointSpecs) <- m_tickInfo
, breakpointsAllowed dflags
- = Just $ mkModBreaks (interpreterProfiled $ hscInterp hsc_env) mod specs
+ = Just $ mkModBreaks (interpreterProfiled $ hscInterp hsc_env) mod breakpointSpecs
| otherwise
= Nothing
; ds_hpc_info <- case m_tickInfo of
- Just (orig_file2, ticks)
+ Just (orig_file2, hpcTicks, _)
| gopt Opt_Hpc $ hsc_dflags hsc_env
-> do
hashNo <- if gopt Opt_Hpc $ hsc_dflags hsc_env
- then writeMixEntries (hpcDir dflags) mod ticks orig_file2
+ then writeMixEntries (hpcDir dflags) mod hpcTicks orig_file2
else return 0 -- dummy hash when none are written
- pure $ HpcInfo (fromIntegral $ sizeSS ticks) hashNo
+ pure $ HpcInfo (fromIntegral $ sizeSS hpcTicks) hashNo
_ -> pure $ emptyHpcInfo
; (msgs, mb_res) <- initDs hsc_env tcg_env $
=====================================
compiler/GHC/HsToCore/Coverage.hs
=====================================
@@ -6,6 +6,9 @@
module GHC.HsToCore.Coverage
( writeMixEntries
, hpcInitCode
+ , hpcStubLabel
+ , hpcModuleName
+ , hpcTickBoxes
) where
import GHC.Prelude as Prelude
@@ -116,24 +119,33 @@ hpcInitCode _ _ (NoHpcInfo {}) = mempty
hpcInitCode platform this_mod (HpcInfo tickCount hashNo)
= initializerCStub platform fn_name decls body
where
- fn_name = mkInitializerStubLabel this_mod (fsLit "hpc")
+ fn_name = hpcStubLabel this_mod
decls = text "StgWord64 " <> tickboxes <> brackets (int tickCount) <> semi
body = text "hs_hpc_module" <>
parens (hcat (punctuate comma [
- doubleQuotes full_name_str,
+ doubleQuotes (hpcModuleName this_mod),
int tickCount, -- really StgWord32
int hashNo, -- really StgWord32
tickboxes
])) <> semi
+ tickboxes = hpcTickBoxes platform this_mod
- tickboxes = pprCLabel platform (mkHpcTicksLabel $ this_mod)
-
- module_name = hcat (map (text.charToC) $ BS.unpack $
- bytesFS (moduleNameFS (moduleName this_mod)))
- package_name = hcat (map (text.charToC) $ BS.unpack $
- bytesFS (unitFS (moduleUnit this_mod)))
- full_name_str
- | moduleUnit this_mod == mainUnit
- = module_name
- | otherwise
- = package_name <> char '/' <> module_name
+hpcStubLabel :: Module -> CLabel
+hpcStubLabel this_mod = mkInitializerStubLabel this_mod (fsLit "hpc")
+
+hpcModuleName :: Module -> SDoc
+hpcModuleName this_mod = full_name_str
+ where
+ full_name_str
+ | moduleUnit this_mod == mainUnit
+ = module_name
+ | otherwise
+ = package_name <> char '/' <> module_name
+ module_name = hcat (map (text.charToC) $ BS.unpack $
+ bytesFS (moduleNameFS (moduleName this_mod)))
+
+ package_name = hcat (map (text.charToC) $ BS.unpack $
+ bytesFS (unitFS (moduleUnit this_mod)))
+
+hpcTickBoxes :: Platform -> Module -> SDoc
+hpcTickBoxes platform this_mod = pprCLabel platform (mkHpcTicksLabel this_mod)
=====================================
compiler/GHC/HsToCore/Ticks.hs
=====================================
@@ -100,7 +100,7 @@ addTicksToBinds
-- hasn't set it), so we have to work from this set.
-> [TyCon] -- ^ Type constructors in this module
-> LHsBinds GhcTc
- -> IO (LHsBinds GhcTc, Maybe (FilePath, SizedSeq Tick))
+ -> IO (LHsBinds GhcTc, Maybe (FilePath, SizedSeq Tick, SizedSeq Tick))
addTicksToBinds logger cfg
mod mod_loc exports tyCons binds
@@ -133,12 +133,13 @@ addTicksToBinds logger cfg
(binds1,st) = foldr tickPass (binds, initTTState) passes
- extendedMixEntries = ticks st
+ hpcEntries = hpcTicks st
+ breakpointEntries = breakpointTicks st
putDumpFileMaybe logger Opt_D_dump_ticked "HPC" FormatHaskell
(pprLHsBinds binds1)
- return (binds1, Just (orig_file2, extendedMixEntries))
+ return (binds1, Just (orig_file2, hpcEntries, breakpointEntries))
| otherwise = return (binds, Nothing)
@@ -1050,23 +1051,31 @@ addTickArithSeqInfo (FromThenTo e1 e2 e3) =
(addTickLHsExpr e2)
(addTickLHsExpr e3)
-data TickTransState = TT { ticks :: !(SizedSeq Tick)
- , ccIndices :: !CostCentreState
- , recSelTicks :: !(IdEnv CoreTickish)
+data TickTransState = TT { hpcTicks :: !(SizedSeq Tick)
+ , breakpointTicks :: !(SizedSeq Tick)
+ , ccIndices :: !CostCentreState
+ , recSelTicks :: !(IdEnv CoreTickish)
}
initTTState :: TickTransState
-initTTState = TT { ticks = emptySS
- , ccIndices = newCostCentreState
- , recSelTicks = emptyVarEnv
+initTTState = TT { hpcTicks = emptySS
+ , breakpointTicks = emptySS
+ , ccIndices = newCostCentreState
+ , recSelTicks = emptyVarEnv
}
-addMixEntry :: Tick -> TM Int
-addMixEntry ent = do
- c <- fromIntegral . sizeSS . ticks <$> getState
+addHpcEntry :: Tick -> TM Int
+addHpcEntry ent = do
+ c <- fromIntegral . sizeSS . hpcTicks <$> getState
setState $ \st ->
- st { ticks = addToSS (ticks st) ent
- }
+ st { hpcTicks = addToSS (hpcTicks st) ent }
+ return c
+
+addBreakpointEntry :: Tick -> TM Int
+addBreakpointEntry ent = do
+ c <- fromIntegral . sizeSS . breakpointTicks <$> getState
+ setState $ \st ->
+ st { breakpointTicks = addToSS (breakpointTicks st) ent }
return c
addRecSelTick :: Id -> CoreTickish -> TM ()
@@ -1291,7 +1300,7 @@ mkTickish boxLabel countEntries topOnly pos fvs decl_path = do
env <- getEnv
case tickishType env of
- HpcTicks -> HpcTick (this_mod env) <$> addMixEntry me
+ HpcTicks -> HpcTick (this_mod env) <$> addHpcEntry me
ProfNotes -> do
flavour <- mkHpcCCFlavour <$> getCCIndexM cc_name
@@ -1300,7 +1309,7 @@ mkTickish boxLabel countEntries topOnly pos fvs decl_path = do
return $ ProfNote cc count True{-scopes-}
Breakpoints -> do
- i <- addMixEntry me
+ i <- addBreakpointEntry me
pure (Breakpoint noExtField (BreakpointId (this_mod env) i) ids)
SourceNotes | RealSrcSpan pos' _ <- pos ->
@@ -1325,19 +1334,19 @@ mkBinTickBoxHpc :: (Bool -> BoxLabel) -> SrcSpan -> LHsExpr GhcTc
mkBinTickBoxHpc boxLabel pos e = do
env <- getEnv
binTick <- HsBinTick
- <$> addMixEntry (Tick { tick_loc = pos
+ <$> addHpcEntry (Tick { tick_loc = pos
, tick_path = declPath env
, tick_ids = []
, tick_label = boxLabel True
})
- <*> addMixEntry (Tick { tick_loc = pos
+ <*> addHpcEntry (Tick { tick_loc = pos
, tick_path = declPath env
, tick_ids = []
, tick_label = boxLabel False
})
<*> pure e
tick <- HpcTick (this_mod env)
- <$> addMixEntry (Tick { tick_loc = pos
+ <$> addHpcEntry (Tick { tick_loc = pos
, tick_path = declPath env
, tick_ids = []
, tick_label = ExpBox False
=====================================
compiler/GHC/Iface/Tidy.hs
=====================================
@@ -402,6 +402,7 @@ tidyProgram opts (ModGuts { mg_module = mod
, mg_foreign_files = foreign_files
, mg_modBreaks = modBreaks
, mg_boot_exports = boot_exports
+ , mg_hpc_info = hpc_info
}) = do
(unfold_env, tidy_occ_env) <- chooseExternalIds opts mod tcs binds imp_rules
@@ -471,6 +472,7 @@ tidyProgram opts (ModGuts { mg_module = mod
, cg_dep_pkgs = S.map snd (dep_direct_pkgs deps)
, cg_modBreaks = modBreaks
, cg_spt_entries = spt_entries
+ , cg_hpc_info = hpc_info
}
, ModDetails { md_types = tidy_type_env
, md_rules = tidy_rules
=====================================
compiler/GHC/Linker/Loader.hs
=====================================
@@ -137,6 +137,10 @@ import qualified Data.IntMap.Strict as IM
import qualified Data.Map.Strict as M
import Foreign.Ptr (nullPtr)
import GHC.ByteCode.Serialize
+-- TODO: this import is wrong
+import GHC.HsToCore.Coverage (hpcModuleName)
+import qualified Data.ByteString.Char8 as BS8
+import qualified GHC.Data.Strict as Strict
-- Note [Linkers and loaders]
-- ~~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -983,10 +987,9 @@ dynLinkBCOs interp pls keep_spec bcos =
let (bcos_loaded', new_bcos) = rmDupLinkables (bcos_loaded pls) bcos
pls1 = pls { bcos_loaded = bcos_loaded' }
- cbcs :: [CompiledByteCode]
- cbcs = concatMap linkableBCOs new_bcos
+ mbcs = concatMap linkableBCOs new_bcos
in do
- bco_state <- dynLinkCompiledByteCode interp (pkgs_loaded pls) (bco_loader_state pls) traverseHomePackageBytecodeState keep_spec cbcs
+ bco_state <- dynLinkCompiledByteCode interp (pkgs_loaded pls) (bco_loader_state pls) traverseHomePackageBytecodeState keep_spec mbcs
return $! pls1 { bco_loader_state = bco_state }
dynLinkCompiledByteCode :: Interp
@@ -996,22 +999,22 @@ dynLinkCompiledByteCode :: Interp
-> KeepModuleLinkableDefinitions
-> [CompiledByteCode]
-> IO BytecodeLoaderState
-dynLinkCompiledByteCode interp pkgs_loaded whole_bytecode_state traverse_bytecode_state keep_spec cbcs = do
+dynLinkCompiledByteCode interp pkgs_loaded whole_bytecode_state traverse_bytecode_state keep_spec mbcs = do
st1 <- traverse_bytecode_state whole_bytecode_state $ \bytecode_state -> do
let
le1 = bco_linker_env bytecode_state
lb1 = bco_linked_breaks bytecode_state
- ie2 <- linkITbls interp (itbl_env le1) (concatMap bc_itbls cbcs)
- ae2 <- foldlM (\env cbc -> allocateTopStrings interp (bc_strs cbc) env) (addr_env le1) cbcs
- be2 <- allocateBreakArrays interp (breakarray_env lb1) (catMaybes $ map bc_breaks cbcs)
- ce2 <- allocateCCS interp (ccs_env lb1) (catMaybes $ map bc_breaks cbcs)
+ ie2 <- linkITbls interp (itbl_env le1) (concatMap bc_itbls mbcs)
+ ae2 <- foldlM (\env cbc -> allocateTopStrings interp (bc_strs cbc) env) (addr_env le1) mbcs
+ be2 <- allocateBreakArrays interp (breakarray_env lb1) (catMaybes $ map bc_breaks mbcs)
+ ce2 <- allocateCCS interp (ccs_env lb1) (catMaybes $ map bc_breaks mbcs)
let le2 = le1 { itbl_env = ie2, addr_env = ae2 }
let lb2 = lb1 { breakarray_env = be2, ccs_env = ce2 }
return $! bytecode_state { bco_linker_env = le2, bco_linked_breaks = lb2 }
-- NB: Important to pass the whole bytecode loader state to linkSomeBCOs so that you can find Names in local
-- and external packages.
- names_and_refs <- linkSomeBCOs interp pkgs_loaded st1 cbcs
+ names_and_refs <- linkSomeBCOs interp pkgs_loaded st1 mbcs
-- We only want to add the external ones to the ClosureEnv
let (to_add, to_drop) = partition (keepDefinitions keep_spec . fst) names_and_refs
@@ -1024,7 +1027,9 @@ dynLinkCompiledByteCode interp pkgs_loaded whole_bytecode_state traverse_bytecod
traverse_bytecode_state st1 $ \bytecode_state -> do
let ce2 = extendClosureEnv (closure_env (bco_linker_env bytecode_state)) new_binds
-- Add SPT entries
- mapM_ (linkSptEntry interp ce2) (concatMap bc_spt_entries cbcs)
+ mapM_ (linkSptEntry interp ce2) (concatMap bc_spt_entries mbcs)
+ -- Load HPC modules
+ mapM_ (linkHpcEntry interp . bc_hpc_info) mbcs
return $! bytecode_state { bco_linker_env = (bco_linker_env bytecode_state) { closure_env = ce2 } }
-- | Register SPT entries for this module in the interpreter
@@ -1037,8 +1042,14 @@ linkSptEntry interp ce (SptEntry name fpr) = do
Nothing -> pprPanic "linkSptEntry" (ppr name)
Just (_, hval) -> addSptEntry interp fpr hval
-
-
+linkHpcEntry :: Interp -> Strict.Maybe ByteCodeHpcInfo -> IO ()
+linkHpcEntry _interp Strict.Nothing = pure ()
+linkHpcEntry interp (Strict.Just info) = do
+ addHpcModule interp
+ (bchi_module_name info)
+ (bchi_tick_count info)
+ (bchi_hash info)
+ (bchi_tickboxes info)
-- Link a bunch of BCOs and return references to their values
linkSomeBCOs :: Interp
=====================================
compiler/GHC/Linker/Types.hs
=====================================
@@ -214,36 +214,37 @@ data BytecodeLoaderState = BytecodeLoaderState
-- ^ Information about bytecode objects from the home package we have loaded into the interpreter.
, externalPackage_loaded :: BytecodeState
-- ^ Information about bytecode objects from external packages we have loaded into the interpreter.
+ , hpcInitialised :: !Bool
}
-- | Find a name loaded from bytecode
lookupNameBytecodeState :: BytecodeLoaderState -> Name -> Maybe (Name, ForeignHValue)
-lookupNameBytecodeState (BytecodeLoaderState home_package external_package) name = do
+lookupNameBytecodeState (BytecodeLoaderState home_package external_package _) name = do
lookupNameEnv (closure_env (bco_linker_env home_package)) name
<|> lookupNameEnv (closure_env (bco_linker_env external_package)) name
-- | Look up a break array in the bytecode loader state.
lookupBreakArrayBytecodeState :: BytecodeLoaderState -> Module -> Maybe (ForeignRef BreakArray)
-lookupBreakArrayBytecodeState (BytecodeLoaderState home_package external_package) break_mod = do
+lookupBreakArrayBytecodeState (BytecodeLoaderState home_package external_package _) break_mod = do
lookupModuleEnv (breakarray_env (bco_linked_breaks home_package)) break_mod
<|> lookupModuleEnv (breakarray_env (bco_linked_breaks external_package)) break_mod
-- | Look up an info table in the bytecode loader state.
lookupInfoTableBytecodeState :: BytecodeLoaderState -> Name -> Maybe (Name, ItblPtr)
-lookupInfoTableBytecodeState (BytecodeLoaderState home_package external_package) info_mod = do
+lookupInfoTableBytecodeState (BytecodeLoaderState home_package external_package _) info_mod = do
lookupNameEnv (itbl_env (bco_linker_env home_package)) info_mod
<|> lookupNameEnv (itbl_env (bco_linker_env external_package)) info_mod
-- | Look up an address in the bytecode loader state.
lookupAddressBytecodeState :: BytecodeLoaderState -> Name -> Maybe (Name, AddrPtr)
-lookupAddressBytecodeState (BytecodeLoaderState home_package external_package) addr_mod = do
+lookupAddressBytecodeState (BytecodeLoaderState home_package external_package _) addr_mod = do
lookupNameEnv (addr_env (bco_linker_env home_package)) addr_mod
<|> lookupNameEnv (addr_env (bco_linker_env external_package)) addr_mod
-- | Look up a cost centre stack in the bytecode loader state.
lookupCCSBytecodeState :: BytecodeLoaderState -> Module -> Maybe (Array BreakTickIndex (RemotePtr CostCentre))
-lookupCCSBytecodeState (BytecodeLoaderState home_package external_package) ccs_mod = do
+lookupCCSBytecodeState (BytecodeLoaderState home_package external_package _) ccs_mod = do
lookupModuleEnv (ccs_env (bco_linked_breaks home_package)) ccs_mod
<|> lookupModuleEnv (ccs_env (bco_linked_breaks external_package)) ccs_mod
@@ -251,6 +252,7 @@ emptyBytecodeLoaderState :: BytecodeLoaderState
emptyBytecodeLoaderState = BytecodeLoaderState
{ homePackage_loaded = emptyBytecodeState
, externalPackage_loaded = emptyBytecodeState
+ , hpcInitialised = False
}
emptyBytecodeState :: BytecodeState
=====================================
compiler/GHC/Runtime/Interpreter.hs
=====================================
@@ -17,6 +17,7 @@ module GHC.Runtime.Interpreter
, mallocData
, createBCOs
, addSptEntry
+ , addHpcModule
, mkCostCentres
, costCentreStackInfo
, newBreakArray
@@ -366,6 +367,10 @@ addSptEntry interp fpr ref =
withForeignRef ref $ \val ->
interpCmd interp (AddSptEntry fpr val)
+addHpcModule :: Interp -> String -> Int -> Int -> String -> IO ()
+addHpcModule interp modLabel tickNo hash tickboxes =
+ interpCmd interp (AddHpcModule modLabel tickNo hash tickboxes)
+
costCentreStackInfo :: Interp -> RemotePtr CostCentreStack -> IO [String]
costCentreStackInfo interp ccs =
interpCmd interp (CostCentreStackInfo ccs)
=====================================
compiler/GHC/StgToByteCode.hs
=====================================
@@ -20,6 +20,7 @@ import GHC.ByteCode.Types
import GHC.Cmm.CallConv
import GHC.Cmm.Expr
+import GHC.Cmm.CLabel (mkHpcTicksLabel, pprCLabel)
import GHC.Cmm.Reg ( GlobalArgRegs(..) )
import GHC.Cmm.Node
import GHC.Cmm.Utils
@@ -97,6 +98,7 @@ import Control.Monad.IO.Class
import Control.Monad.Trans.Reader (ReaderT(..))
import Control.Monad.Trans.State (StateT(..))
import Data.Bifunctor (Bifunctor(..))
+import qualified GHC.Data.Strict as Strict
-- -----------------------------------------------------------------------------
-- Generating byte code for a complete module
@@ -107,8 +109,9 @@ byteCodeGen :: HscEnv
-> [TyCon]
-> Maybe ModBreaks
-> [SptEntry]
+ -> Strict.Maybe ByteCodeHpcInfo
-> IO CompiledByteCode
-byteCodeGen hsc_env this_mod binds tycs mb_modBreaks spt_entries
+byteCodeGen hsc_env this_mod binds tycs mb_modBreaks spt_entries hpc_info
= withTiming logger
(text "GHC.StgToByteCode"<+>brackets (ppr this_mod))
(const ()) $ do
@@ -134,7 +137,7 @@ byteCodeGen hsc_env this_mod binds tycs mb_modBreaks spt_entries
let mod_breaks = case mb_modBreaks of
Nothing -> Nothing
Just mb -> Just $ mkInternalModBreaks this_mod breakInfo mb
- cbc <- assembleBCOs profile proto_bcos tycs strings mod_breaks spt_entries
+ cbc <- assembleBCOs profile proto_bcos tycs strings mod_breaks spt_entries hpc_info
-- Squash space leaks in the CompiledByteCode. This is really
-- important, because when loading a set of modules into GHCi
@@ -604,6 +607,11 @@ schemeE _d _s _p (StgTick (Breakpoint _ bp_id _) _rhs)
= pprPanic "schemeE: Breakpoint without let binding:"
(ppr bp_id <+> text "forgot to run bcPrep?")
+schemeE d s p (StgTick (HpcTick mod ix) rhs) = do
+ platform <- profilePlatform <$> getProfile
+ rhs_code <- schemeE d s p rhs
+ pure (unitOL (HPC_TICK (mkHpcTickLabel platform mod) (fromIntegral ix)) `appOL` rhs_code)
+
-- ignore other kinds of tick
schemeE d s p (StgTick _ rhs) = schemeE d s p rhs
@@ -2784,6 +2792,10 @@ getLastBreakTick = BcM $ \env st ->
tickFS :: FastString
tickFS = fsLit "ticked"
+mkHpcTickLabel :: Platform -> Module -> FastString
+mkHpcTickLabel platform mod =
+ fsLit (showSDocOneLine defaultSDocContext (pprCLabel platform (mkHpcTicksLabel mod)))
+
-- Dehydrating CgBreakInfo
dehydrateCgBreakInfo :: [TyVar] -> [Maybe (Id, Word)] -> Type -> Either InternalBreakLoc BreakpointId -> CgBreakInfo
=====================================
compiler/GHC/Types/HpcInfo.hs
=====================================
@@ -18,4 +18,3 @@ data HpcInfo
emptyHpcInfo :: HpcInfo
emptyHpcInfo = NoHpcInfo
-
=====================================
compiler/GHC/Unit/Module/ModGuts.hs
=====================================
@@ -141,8 +141,9 @@ data CgGuts
cg_dep_pkgs :: !(Set UnitId), -- ^ Dependent packages, used to
-- generate #includes for C code gen
cg_modBreaks :: !(Maybe ModBreaks), -- ^ Module breakpoints
- cg_spt_entries :: [SptEntry]
+ cg_spt_entries :: [SptEntry],
-- ^ Static pointer table entries for static forms defined in
-- the module.
-- See Note [Grand plan for static forms] in "GHC.Iface.Tidy.StaticPtrTable"
+ cg_hpc_info :: HpcInfo
}
=====================================
libraries/ghci/GHCi/Coverage.hs
=====================================
@@ -0,0 +1,51 @@
+{-# LANGUAGE ForeignFunctionInterface #-}
+{-# LANGUAGE LambdaCase #-}
+
+module GHCi.Coverage (
+ hpcAddModule,
+ ) where
+
+import Prelude -- See note [Why do we import Prelude here?]
+
+import Control.Exception
+import qualified Data.ByteString.Char8 as BS8
+import qualified Data.ByteString.Unsafe as B
+import Data.Word
+import Foreign
+import Foreign.C.String (withCAString)
+import GHC.Fingerprint
+import GHC.Foreign (CString)
+import GHCi.ObjLink (lookupSymbol)
+
+-- | Inform the run-time system that the given module name is instrumented via @hpc@
+-- and to collect @.tix@ info.
+--
+-- Starts the `hpc` run-time if it hasn't already been started.
+hpcAddModule ::
+ String ->
+ -- ^ Name of the module to instrument
+ Int ->
+ -- ^ Number of hpc ticks in this module
+ Int ->
+ -- ^ 'HpcInfo's 'hpcInfoHash'
+ String ->
+ -- ^ Name of the ticks array found in the c-stub.
+ IO ()
+hpcAddModule modlName ticks hash tickboxes = do
+ withCAString modlName $ \modlNameLiteral -> do
+ -- we need to find the reference to the ticks array.
+ lookupSymbol tickboxes >>= \ case
+ Nothing -> do
+ -- the symbol is not found, this is a bug!
+ throwIO $ ErrorCall $ "hpcAddModule: failed to find symbol " <> tickboxes
+ Just tickBoxRef -> do
+ -- Calling 'hs_hpc_module' multiple times is safe, it will add the module only once.
+ hpc_register_module modlNameLiteral (fromIntegral ticks) (fromIntegral hash) (castPtr tickBoxRef)
+ -- calling 'hpc_startup' multiple times is safe, it will only be initialised once.
+ hpc_startup
+
+foreign import ccall "hs_hpc_module"
+ hpc_register_module :: CString -> Word32 -> Word32 -> Ptr Word64 -> IO ()
+
+foreign import ccall "startupHpc"
+ hpc_startup :: IO ()
=====================================
libraries/ghci/GHCi/Message.hs
=====================================
@@ -111,6 +111,8 @@ data Message a where
-- | Add entries to the Static Pointer Table
AddSptEntry :: Fingerprint -> HValueRef -> Message ()
+ -- | Add module to hpc
+ AddHpcModule :: String -> Int -> Int -> String -> Message ()
-- | Malloc some data and return a 'RemotePtr' to it
MallocData :: ByteString -> Message (RemotePtr ())
@@ -607,7 +609,8 @@ getMessage = do
38 -> Msg <$> (ResumeSeq <$> get)
39 -> Msg <$> (LookupSymbolInDLL <$> get <*> get)
40 -> Msg <$> (WhereFrom <$> get)
- 41 -> Msg <$> (CustomMessage <$> get <*> get)
+ 41 -> Msg <$> (AddHpcModule <$> get <*> get <*> get <*> get)
+ 42 -> Msg <$> (CustomMessage <$> get <*> get)
_ -> error $ "Unknown Message code " ++ (show b)
putMessage :: Message a -> Put
@@ -654,7 +657,8 @@ putMessage m = case m of
ResumeSeq a -> putWord8 38 >> put a
LookupSymbolInDLL dll str -> putWord8 39 >> put dll >> put str
WhereFrom a -> putWord8 40 >> put a
- CustomMessage tag payload -> putWord8 41 >> put tag >> put payload
+ AddHpcModule m n h ticks -> putWord8 41 >> put m >> put n >> put h >> put ticks
+ CustomMessage tag payload -> putWord8 42 >> put tag >> put payload
{-
Note [Parallelize CreateBCOs serialization]
=====================================
libraries/ghci/GHCi/Run.hs
=====================================
@@ -19,6 +19,7 @@ import GHCi.CreateBCO
import GHCi.InfoTable
#endif
+import GHCi.Coverage
import qualified GHC.InfoProv as InfoProv
import GHCi.Debugger
import GHCi.FFI
@@ -88,6 +89,7 @@ run m = case m of
fmap toRemotePtr <$> lookupSymbolInDLL (fromRemotePtr dll) str
FreeHValueRefs rs -> mapM_ freeRemoteRef rs
AddSptEntry fpr r -> localRef r >>= sptAddEntry fpr
+ AddHpcModule modl ticks hash tickboxes -> hpcAddModule modl ticks hash tickboxes
EvalStmt opts r -> evalStmt opts r
ResumeStmt opts r -> resumeStmt opts r
AbandonStmt r -> abandonStmt r
=====================================
libraries/ghci/ghci.cabal.in
=====================================
@@ -59,6 +59,7 @@ library
if flag(internal-interpreter)
CPP-Options: -DHAVE_INTERNAL_INTERPRETER
exposed-modules:
+ GHCi.Coverage
GHCi.Run
GHCi.Debugger
GHCi.CreateBCO
=====================================
rts/Disassembler.c
=====================================
@@ -101,6 +101,13 @@ disInstr ( StgBCO *bco, int pc )
}
debugBelch("\n");
break; }
+ case bci_HPC_TICK: {
+ W_ p1, info_wix;
+ p1 = BCO_GET_LARGE_ARG;
+ info_wix = BCO_READ_NEXT_32;
+ debugBelch("HPC_TICK "); printPtr((StgPtr)literals[p1]);
+ debugBelch(" %" FMT_Word "\n", info_wix);
+ break; }
case bci_SWIZZLE: {
W_ stkoff = BCO_GET_LARGE_ARG;
StgInt by = BCO_GET_LARGE_ARG;
=====================================
rts/Hpc.c
=====================================
@@ -270,6 +270,9 @@ hs_hpc_module(char *modName,
HpcModuleInfo *tmpModule;
uint32_t i;
+ debugTrace(DEBUG_hpc, "hs_hpc_module(%s, count=%u, hash=%u)\n",
+ modName, modCount, modHashNo);
+
if (moduleHash == NULL) {
moduleHash = allocStrHashTable();
}
=====================================
rts/Interpreter.c
=====================================
@@ -1711,7 +1711,7 @@ run_BCO:
&&lbl_bci_TESTEQ_W8 - &&lbl_bci_DEFAULT,
&&lbl_bci_PRIMCALL - &&lbl_bci_DEFAULT,
&&lbl_bci_BCO_NAME - &&lbl_bci_DEFAULT,
- &&lbl_bci_DEFAULT - &&lbl_bci_DEFAULT,
+ &&lbl_bci_HPC_TICK - &&lbl_bci_DEFAULT,
&&lbl_bci_OP_ADD_64 - &&lbl_bci_DEFAULT,
&&lbl_bci_OP_SUB_64 - &&lbl_bci_DEFAULT,
&&lbl_bci_OP_AND_64 - &&lbl_bci_DEFAULT,
@@ -2078,6 +2078,18 @@ run_BCO:
NEXT_INSTRUCTION;
}
+ INSTRUCTION(bci_HPC_TICK): {
+ W_ arg1_ticks_array, arg2_tick_index;
+ arg1_ticks_array = BCO_GET_LARGE_ARG;
+ arg2_tick_index = BCO_READ_NEXT_32;
+ IF_DEBUG(hpc,
+ debugBelch("\tHPC Tick %lu %lu %lu\n", BCO_LIT(arg1_ticks_array), arg1_ticks_array, arg2_tick_index);
+ );
+
+ ((StgWord64*)BCO_LIT(arg1_ticks_array))[arg2_tick_index]++;
+ NEXT_INSTRUCTION;
+ }
+
INSTRUCTION(bci_STKCHECK): {
// Explicit stack check at the beginning of a function
// *only* (stack checks in case alternatives are
=====================================
rts/include/rts/Bytecodes.h
=====================================
@@ -118,6 +118,7 @@
#define bci_PRIMCALL 87
#define bci_BCO_NAME 88
+#define bci_HPC_TICK 89
#define bci_OP_ADD_64 90
#define bci_OP_SUB_64 91
=====================================
testsuite/tests/hpc/ghc_ghci/BytecodeMain.hs
=====================================
@@ -0,0 +1,10 @@
+module Main where
+
+inc :: Int -> Int
+inc x = x + 1
+
+double :: Int -> Int
+double x = x * 2
+
+main :: IO ()
+main = print (double (inc 1011))
=====================================
testsuite/tests/hpc/ghc_ghci/Makefile
=====================================
@@ -7,3 +7,9 @@ hpc_ghc_ghci:
'$(TEST_HC)' $(TEST_HC_OPTS) -fhpc -c A.hs
echo b | '$(TEST_HC)' $(TEST_HC_OPTS_INTERACTIVE) B.hs
+hpc_ghc_ghci_bytecode:
+ rm -f ./*.tix
+ printf "main\n:quit\n" | '$(TEST_HC)' $(TEST_HC_OPTS_INTERACTIVE) -fhpc -fbyte-code-and-object-code -fprefer-byte-code BytecodeMain.hs
+ @[ -f .hpc/Main.mix ] || (echo "ERROR: Expected .hpc/Main.mix file not found"; exit 1)
+ @set -- ./*.tix; [ -f "$$1" ] || (echo "ERROR: Expected .tix file not found"; exit 1); '$(HPC)' report "$$1" Main > hpc-report.txt
+ @grep -F "100% expressions used" hpc-report.txt >/dev/null || (echo "ERROR: Expected full expression coverage in hpc report"; cat hpc-report.txt; exit 1)
=====================================
testsuite/tests/hpc/ghc_ghci/hpc_ghc_ghci_bytecode.stdout
=====================================
@@ -0,0 +1 @@
+2024
=====================================
testsuite/tests/hpc/ghc_ghci/test.T
=====================================
@@ -3,3 +3,8 @@ test('hpc_ghc_ghci',
[extra_files(['A.hs', 'B.hs']),
only_ways(['normal']), when(compiler_profiled(), skip), req_interp],
run_command, ['$MAKE -s --no-print-directory hpc_ghc_ghci'])
+
+test('hpc_ghc_ghci_bytecode',
+ [extra_files(['BytecodeMain.hs']),
+ only_ways(['normal']), when(compiler_profiled(), skip), req_interp],
+ run_command, ['$MAKE -s --no-print-directory hpc_ghc_ghci_bytecode'])
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/467794d84015c454aa5a38951d3a7c1…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/467794d84015c454aa5a38951d3a7c1…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/fendor/hpc-bc-support] 91 commits: Introduce `-fimport-loaded-targets` GHCi flag
by Hannes Siebenhandl (＠fendor) 02 Apr '26
by Hannes Siebenhandl (＠fendor) 02 Apr '26
02 Apr '26
Hannes Siebenhandl pushed to branch wip/fendor/hpc-bc-support at Glasgow Haskell Compiler / GHC
Commits:
86bd9bfc by fendor at 2026-03-17T23:46:09-04:00
Introduce `-fimport-loaded-targets` GHCi flag
This new flag automatically adds all loaded targets to the GHCi session
by adding an `InteractiveImport` for the loaded targets.
By default, this flag is disabled, as it potentially increases memory-usage.
This interacts with the flag `-fno-load-initial-targets` as follows:
* If no module is loaded, no module is added as an interactive import.
* If a reload loads up to a module, all loaded modules are added as
interactive imports.
* Unloading modules removes them from the interactive context.
Fixes #26866 by rendering the use of a `-ghci-script` to achieve the
same thing redundant.
- - - - -
e3d4c1bb by mniip at 2026-03-17T23:47:03-04:00
ghc-internal: Remove GHC.Internal.Data.Eq
It served no purpose other than being a re-export.
- - - - -
6f4f6cf0 by mniip at 2026-03-17T23:47:03-04:00
ghc-internal: Refine GHC.Internal.Base imports
Removed re-exports from GHC.Internal.Base. This reveals some modules
that don't actually use anything *defined* in GHC.Internal.Base, and
that can be pushed down a little in the import graph.
Replaced most imports of GHC.Internal.Base with non-wildcard imports
from modules where the identifiers are actually defined.
Part of #26834
Metric Decrease:
T5321FD
- - - - -
7fb51f54 by mangoiv at 2026-03-17T23:48:00-04:00
ci: clone, don't copy when creating the cabal cache
Also removed WINDOWS_HOST variable detected via uname - we now just
check whether the CI job has windows in its name. This works because we
only ever care about it if the respective job is not a cross job. We
also statically detect darwin cross jobs in the same way. We only ever have
darwin -> darwin cross jobs so this is enough to detect the host
reliably.
- - - - -
f8817879 by mangoiv at 2026-03-17T23:48:44-04:00
ci: mark size_hello_artifact fragile on darwin x86
The size of the x86_64 hello artifact is not stable which results in flaky testruns.
Resolves #26814
- - - - -
e34cb6da by Adam Gundry at 2026-03-20T12:20:00-04:00
ghci: Mention active language edition in startup banner
Per GHC proposal 632, this makes the GHCi startup banner include
the active language edition, plus an indication of whether this
was the default (as opposed to being explicitly selected via an
option such as `-XGHC2024`). For example:
```
$ ghci
GHCi, version 9.14.1: https://www.haskell.org/ghc/ :? for help
Using default language edition: GHC2024
ghci>
```
Fixes #26037.
- - - - -
52c3e6ba by sheaf at 2026-03-20T12:21:09-04:00
Improve incomplete record selector warnings
This commit stops GHC from emitting spurious incomplete record selector
warnings for bare selectors/projections such as .fld
There are two places we currently emit incomplete record selector
warnings:
1. In the desugarer, when we see a record selector or an occurrence
of 'getField'. Here, we can use pattern matching information to
ensure we don't give false positives.
2. In the typechecker, which might sometimes give false positives but
can emit warnings in cases that the pattern match checker would
otherwise miss.
This is explained in Note [Detecting incomplete record selectors]
in GHC.HsToCore.Pmc.
Now, we obviously don't want to emit the same error twice, and generally
we prefer (1), as those messages contain fewer false positives. So we
suppress (2) when we are sure we are going to emit (1); the logic for
doing so is in GHC.Tc.Instance.Class.warnIncompleteRecSel,
and works by looking at the CtOrigin.
Now, the issue was that this logic handled explicit record selectors as
well as overloaded record field selectors such as "x.r" (which turns
into a simple GetFieldOrigin CtOrigin), but it didn't properly handle
record projectors like ".fld" or ".fld1.fld2" (which result in other
CtOrigins such as 'RecordFieldProjectionOrigin').
To solve this problem, we re-use the 'isHasFieldOrigin' introduced in
fbdc623a (slightly adjusted).
On the way, we also had to update the desugarer with special handling
for the 'ExpandedThingTc' case in 'ds_app', to make sure that
'ds_app_var' sees all the type arguments to 'getField' in order for it
to indeed emit warnings like in (1).
Fixes #26686
- - - - -
309d7e87 by Cheng Shao at 2026-03-20T12:21:53-04:00
rts: opportunistically grow the MutableByteArray# in-place in resizeMutableByteArray#
Following !15234, this patch improves `resizeMutableByteArray#` memory
efficiency by growing the `MutableByteArray#` in-place if possible,
addressing an old todo comment here. Also adds a new test case
`resizeMutableByteArrayInPlace` that stresses this behavior.
- - - - -
7d4ef162 by Matthew Craven at 2026-03-20T12:22:47-04:00
Change representation of floating point literals
This commit changes the representation of floating point literals
throughough the compiler, in particular in Core and Cmm.
The Rational type is deficient for this purpose, dealing poorly
with NaN, +/-Infinity, and negative zero. Instead, the new module
GHC.Types.Literal.Floating uses the host Float/Double type to represent
NaNs, infinities and negative zero. It also contains a Rational
constructor, for the benefit of -fexcess-precision.
Other changes:
- Remove Note [negative zero] and related code
This also removes the restrictions on constant-folding of division
by zero, and should make any problems with NaN/Infinity more obvious.
- Use -0.0 as the additive identity for Core constant folding rules
for floating-point addition, fixing #21227.
- Manual worker-wrapper for GHC.Float.rationalToDouble. This is
intended to prevent the compiler's WW on this function from
interfering with constant-folding. This change means that we now
avoid allocating a box for the result of a 'realToFrac' call in
T10359.
- Combine floatDecodeOp and doubleDecodeOp.
This change also fixes a bug in doubleDecodeOp wherein it
would incorrectly produce an Int# instead of an Int64#
literal for the mantissa component with 64-bit targets.
- Use Float/Double for assembly immediates, and update the X86 and
PowerPC backends to properly handle special values such as NaN and
infinity.
- Allow 'rational_to' to handle zero denominators, fixing a
TODO in GHC.Core.Opt.ConstantFold.
Fixes #8364 #9811 #18897 #21227
Progress towards #26919
Metric Decrease:
T10359
Co-authored-by: sheaf <sam.derbyshire(a)gmail.com>
-------------------------
Metric Decrease:
T1969
T5321FD
-------------------------
- - - - -
80e2dd4f by Zubin Duggal at 2026-03-20T12:23:33-04:00
compiler/ffi: Collapse void pointer chains in capi wrappers
New gcc/clang treat -Wincompatible-pointer-types as an error by
default. Since C only allows implicit conversion from void*, not void**,
capi wrappers for functions taking e.g. abstract** would fail to compile
when the Haskell type Ptr (Ptr Abstract) was naively translated to void**.
Collapse nested void pointers to a single void* when the pointee type
has no known C representation.
Fixes #26852
- - - - -
1c50bd7b by Luite Stegeman at 2026-03-20T12:24:37-04:00
Move some functions related to pointer tagging to a separate module
- - - - -
bfd7aafd by Luite Stegeman at 2026-03-20T12:24:37-04:00
Branchless unpacking for enumeration types
Change unpacking for enumeration types to go to Word8#/Word16#/Word#
directly instead of going through an intermediate unboxed sum. This
allows us to do a branchless conversion using DataToTag and TagToEnum.
Fixes #26970
- - - - -
72b20fc0 by Luite Stegeman at 2026-03-20T12:25:30-04:00
bytecode: Carefully SLIDE off the end of a stack chunk
The SLIDE bytecode instruction was not checking for stack chunk
boundaries and could corrupt the stack underflow frame, leading
to crashes.
We add a check to use safe writes if we cross the chunk boundary
and also handle stack underflow if Sp is advanced past the underflow
frame.
fix #27001
- - - - -
2e22b43c by Cheng Shao at 2026-03-20T12:26:14-04:00
ghci: serialize BCOByteArray buffer directly when possible
This patch changes the `Binary` instances of `BCOByteArray` to
directly serialize the underlying buffer when possible, while also
taking into account the issue of host-dependent `Word` width. See
added comments and amended `Note [BCOByteArray serialization]` for
detailed explanation. Closes #27020.
- - - - -
89d9ba37 by Sylvain Henry at 2026-03-20T12:27:34-04:00
JS: replace BigInt with Number arithmetic for 32/64-bit quot/rem (#23597)
Replace BigInt-based implementations of quotWord32, remWord32,
quotRemWord32, quotRem2Word32, quotWord64, remWord64, quotInt64, and
remInt64 with pure Number (double/integer) arithmetic to avoid the
overhead of BigInt promotion.
- - - - -
ae4ddd60 by Sylvain Henry at 2026-03-20T12:28:28-04:00
Core: add constant-folding rules for Addr# eq/ne (#18032)
- - - - -
3e767f98 by Matthew Pickering at 2026-03-20T12:29:11-04:00
Use OsPath rather than FilePath in Downsweep cache
This gets us one step closure to uniformly using `OsPath` in the
compiler.
- - - - -
2c57de29 by Cheng Shao at 2026-03-20T12:29:55-04:00
hadrian: fix ghc-in-ghci flavour stage0 shared libraries
This patch fixes missing stage0 shared libraries in hadrian
ghc-in-ghci flavour, which was accidentally dropped in
669d09f950a6e88b903d9fd8a7571531774d4d5d and resulted in a regression
in HLS support on linux/macos. Fixes #27057.
- - - - -
5b1be555 by Sylvain Henry at 2026-03-20T12:30:48-04:00
JS: install rts/Types.h header file (#27033)
It was an omission, making HsFFI.h not usable with GHC using the JS
backend.
- - - - -
b883f08f by Cheng Shao at 2026-03-20T12:31:33-04:00
hadrian: don't compile RTS with -Winline
This patch removes `-Winline` from cflags when compiling the RTS,
given that:
1. It generates a huge pile of spam and hurts developer experience
2. Whether inlining happens is highly dependent on toolchains,
flavours, etc, and it's not really an issue to fix if inlining
doesn't happen; it's a hint to the C compiler anyway.
Fixes #27060.
- - - - -
333387d6 by Cheng Shao at 2026-03-20T12:31:33-04:00
hadrian: compile libffi-clib with -Wno-deprecated-declarations
This patch adds `-Wno-deprecated-declarations` to cflags of
`libffi-clib`, given that it produces noise at compile-time that
aren't really our issue to fix anyway, it's from vendored libffi
source code.
- - - - -
67c47771 by Rodrigo Mesquita at 2026-03-20T12:32:17-04:00
Expose decodeStackWithIpe from ghc-experimental
This decoding is useful to the debugger and it wasn't originally
exported as an oversight.
- - - - -
18513365 by Matthew Pickering at 2026-03-21T04:43:26-04:00
Add support for custom external interpreter commands
It can be useful for GHC API clients to implement their own external
interpreter commands.
For example, the debugger may want an efficient way to inspect the
stacks of the running threads in the external interpreter.
- - - - -
4636d906 by mangoiv at 2026-03-21T04:44:10-04:00
ci: remove obsolete fallback for old debian and ubuntu versions
- - - - -
2e3a2805 by mangoiv at 2026-03-21T04:44:10-04:00
ci: drop ubuntu 18 and 20
Ubuntu 18 EOL: May 2023
Ubuntu 20 EOL: May 2025
We should probably not make another major release supporting these platforms.
Also updates the generator script.
Resolves #25876
- - - - -
de54e264 by Cheng Shao at 2026-03-21T17:52:08+01:00
rts: fix -Wcompare-distinct-pointer-types errors
This commit fixes `-Wcompare-distinct-pointer-types` errors in the RTS
which should have been caught by the `validate` flavour but was
warnings in CI due to the recent `+werror` regression.
- - - - -
b9bd73de by Cheng Shao at 2026-03-21T17:52:08+01:00
ghc-internal: fix unused imports
This commit fixes unused imports in `ghc-internal` which should have
been caught by the `validate` flavour but was warnings in CI due to
the recent `+werror` regression. Fixes #26987 #27059.
- - - - -
da946a16 by Cheng Shao at 2026-03-21T17:03:51+00:00
ghci: fix unused imports
This commit fixes unused imports in `ghci` which should have been
caught by the `validate` flavour but was warnings in CI due to the
recent `+werror` regression. Fixes #26987 #27059.
- - - - -
955b1cf8 by Cheng Shao at 2026-03-21T17:03:51+00:00
compiler: fix unused imports in GHC.Tc.Types.Origin
This commit fixes unused imports in `GHC.Tc.Types.Origin` which should
have been caught by the `validate` flavour but was warnings in CI due
to the recent `+werror` regression. Fixes #27059.
- - - - -
3b1aeb50 by Cheng Shao at 2026-03-21T17:03:51+00:00
hadrian: fix missing +werror in validate flavour
This patch fixes missing `+werror` in validate flavour, which was an
oversight in bb3a2ba1eefadf0b2ef4f39b31337a23eec67f29. Fixes #27066.
- - - - -
44f118f0 by Cheng Shao at 2026-03-22T04:54:01-04:00
ci: bump CACHE_REV and add the missing reminder
This patch bumps `CACHE_REV` to address recent `[Cabal-7159]` CI
errors due to stale cabal cache on some runners, and also adds a
reminder to remind future maintainers. Fixes #27075.
- - - - -
2a218737 by ARATA Mizuki at 2026-03-23T11:11:39-04:00
Add 128-bit SIMD support to AArch64 NCG
Changes:
- Add `Format` field to vector-capable instructions.
These instructions will emit `vN.4s` (for example) as a operand.
- Additional constructors for `Operand`:
`OpVecLane` represents a vector lane and will be emitted as `vN.<width>[<index>]` (`vN.s[3]` for example).
`OpScalarAsVec` represents a scalar, but printed as a vector lane like `vN.<width>[0]` (`vN.s[0]` for example).
- Integer quot/rem are implemented in C, like x86.
Closes #26536
Metric Increase:
T3294
- - - - -
5d6e2be9 by ARATA Mizuki at 2026-03-23T11:11:39-04:00
AArch64 NCG: Improve code generation for floating-point and vector constants
Some floating-point constants can be directly encoded using the FMOV instruction.
Similarly, a class of vectors with same values can be encoded using FMOV, MOVI, or MVNI.
- - - - -
c6d262aa by Simon Jakobi at 2026-03-23T11:12:22-04:00
Add regression test for #13729
Closes #13729.
- - - - -
aa5dfe67 by Sylvain Henry at 2026-03-26T03:48:56-04:00
Check that shift values are valid
In GHC's codebase in non-DEBUG builds we silently substitute shiftL/R
with unsafeShiftL/R for performance reasons. However we were not
checking that the shift value was valid for unsafeShiftL/R, leading to
wrong computations, but only in non-DEBUG builds.
This patch adds the necessary checks and reports an error when a wrong
shift value is passed.
- - - - -
c8a7b588 by Sylvain Henry at 2026-03-26T03:48:56-04:00
Implement basic value range analysis (#25718)
Perform basic value range analysis to try to determine at compile time
the result of the application of some comparison primops (ltWord#, etc.).
This subsumes the built-in rewrite rules used previously to check if one
of the comparison argument was a bound (e.g. (x :: Word8) <= 255 is
always True). Our analysis is more powerful and handles type
conversions: e.g. word8ToWord x <= 255 is now detected as always True too.
We also use value range analysis to filter unreachable alternatives in
case-expressions. To support this, we had to allow case-expressions for
primitive types to not have a DEFAULT alternative (as was assumed before
and checked in Core lint).
- - - - -
a5ec467e by ARATA Mizuki at 2026-03-26T03:49:49-04:00
rts: Align stack to 64-byte boundary in StgRun on x86
When LLVM spills AVX/AVX-512 vector registers to the stack, it requires
32-byte (__m256) or 64-byte (__m512) alignment. If the stack is not
sufficiently aligned, LLVM inserts a realignment prologue that reserves
%rbp as a frame pointer, conflicting with GHC's use of %rbp as an STG
callee-saved register and breaking the tail-call-based calling convention.
Previously, GHC worked around this by lying to LLVM about the stack
alignment and rewriting aligned vector loads/stores (VMOVDQA, VMOVAPS)
to unaligned ones (VMOVDQU, VMOVUPS) in the LLVM Mangler. This had two
problems:
- It did not extend to AVX-512, which requires 64-byte alignment. (#26595)
- When Haskell calls a C function that takes __m256/__m512 arguments on
the stack, the callee requires genuine alignment, which could cause a
segfault. (#26822)
This patch genuinely aligns the stack to 64 bytes in StgRun by saving
the original stack pointer before alignment and restoring it in
StgReturn. We now unconditionally advertise 64-byte stack alignment to
LLVM for all x86 targets, making rewriteAVX in the LLVM Mangler
unnecessary. STG_RUN_STACK_FRAME_SIZE is increased from 48 to 56 bytes
on non-Windows x86-64 to store the saved stack pointer.
Closes #26595 and #26822
Co-Authored-By: Claude Opus 4.5 <noreply(a)anthropic.com>
- - - - -
661da815 by Teo Camarasu at 2026-03-26T03:50:33-04:00
ghc-internal: Float Generics to near top of module graph
We remove GHC.Internal.Generics from the critical path of the
`ghc-internal` module graph. GHC.Internal.Generics used to be in the
middle of the module graph, but now it is nearer the top (built later).
This change thins out the module graph and allows us to get rid of the
ByteOrder hs-boot file.
We implement this by moving Generics instances from the module where the
datatype is defined to the GHC.Internal.Generics module. This trades off
increasing the compiled size of GHC.Internal.Generics with reducing the
dependency footprint of datatype modules.
Not all instances are moved to GHC.Internal.Generics. For instance,
`GHC.Internal.Control.Monad.Fix` keeps its instance as it is one of the
very last modules compiled in `ghc-internal` and so inverting the
relationship here would risk adding GHC.Internal.Generics back onto the
critical path.
We also don't change modules that are re-exported from the `template-haskell` or `ghc-heap`.
This is done to make it easy to eventually move `Generics` to `base`
once something like #26657 is implemented.
Resolves #26930
Metric Decrease:
T21839c
- - - - -
45428f88 by sheaf at 2026-03-26T03:51:31-04:00
Avoid infinite loop in deep subsumption
This commit ensures we only unify after we recur in the deep subsumption
code in the FunTy vs non-FunTy case of GHC.Tc.Utils.Unify.tc_sub_type_deep,
to avoid falling into an infinite loop.
See the new Wrinkle [Avoiding a loop in tc_sub_type_deep] in
Note [FunTy vs non-FunTy case in tc_sub_type_deep] in GHC.Tc.Utils.Unify.
Fixes #26823
Co-authored-by: simonpj <simon.peytonjones(a)gmail.com>
- - - - -
2823b039 by Ian Duncan at 2026-03-26T03:52:21-04:00
AArch64: fix MOVK regUsageOfInstr to mark dst as both read and written
MOVK (move with keep) modifies only a 16-bit slice of the destination
register, so the destination is both read and written. The register
allocator must know this to avoid clobbering live values. Update
regUsageOfInstr to list the destination in both src and dst sets.
No regression test: triggering the misallocation requires specific
register pressure around a MOVK sequence, which is difficult to
reliably provoke from Haskell source.
- - - - -
57b7878d by Simon Jakobi at 2026-03-26T03:53:07-04:00
Add regression test for #12002
Closes #12002.
- - - - -
c8f9df2d by Simon Jakobi at 2026-03-26T03:53:07-04:00
Add regression test for #12046
Closes #12046.
Co-authored-by: Andreas Klebinger <klebinger.andreas(a)gmx.at>
- - - - -
615d72ac by Simon Jakobi at 2026-03-26T03:53:07-04:00
Add regression test for #13180
Closes #13180.
- - - - -
423eebcf by Simon Jakobi at 2026-03-26T03:53:07-04:00
Add regression test for #11141
Closes #11141.
- - - - -
286849a4 by Simon Jakobi at 2026-03-26T03:53:07-04:00
Add regression test for #11505
Closes #11505.
- - - - -
7db149d9 by Simon Jakobi at 2026-03-26T03:53:07-04:00
Add regression perf test for #13820
Closes #13820.
- - - - -
e73c4adb by Simon Jakobi at 2026-03-26T03:53:07-04:00
Add regression test for #10381
Closes #10381.
- - - - -
5ebcfb57 by Benjamin Maurer at 2026-03-26T03:54:02-04:00
Generate assembly on x86 for word2float (#22252)
We used to emit C function call for MO_UF_Conv primitive.
Now emits direct assembly instead.
Co-Authored-By: Sylvain Henry <sylvain(a)haskus.fr>
Co-Authored-By: Claude Sonnet 4.6 <noreply(a)anthropic.com>
- - - - -
5b550754 by Matthew Pickering at 2026-03-26T03:54:51-04:00
rts: forward clone-stack messages after TSO migration
MSG_CLONE_STACK assumed that the target TSO was still owned by the
capability that received the message. This is not always true: the TSO
can migrate before the inbox entry is handled.
When that happened, handleCloneStackMessage could clone a live stack from
the wrong capability and use the wrong capability for allocation and
performTryPutMVar, leading to stack sanity failures such as
checkStackFrame: weird activation record found on stack.
Fix this by passing the current capability into
handleCloneStackMessage, rechecking msg->tso->cap at handling time, and
forwarding the message if the TSO has migrated. Once ownership matches,
use the executing capability consistently for cloneStack, rts_apply, and
performTryPutMVar.
Fixes #27008
- - - - -
ef0a1bd2 by mangoiv at 2026-03-26T03:55:34-04:00
release tracking: adopt release tracking ticket from #16816
- - - - -
a7f40fd9 by mangoiv at 2026-03-26T03:55:34-04:00
release tracking: add a release tracking ticket
Brings the information in the release tracking ticket up to date with
https://gitlab.haskell.org/ghc/ghc-hq/-/blob/main/release-management.mkd
Resolves #26691
- - - - -
161d3285 by Teo Camarasu at 2026-03-26T03:56:18-04:00
Revert "Set default eventlog-flush-interval to 5s"
Flushing the eventlog forces a synchronisation of all the capabilities
and there was a worry that this might lead to a performance cost for
some highly parallel workloads.
This reverts commit 66b96e2a591d8e3d60e74af3671344dfe4061cf2.
- - - - -
36eed985 by Cheng Shao at 2026-03-26T03:57:03-04:00
ghc-boot: move GHC.Data.SmallArray to ghc-boot
This commit moves `GHC.Data.SmallArray` from the `ghc` library to
`ghc-boot`, so that it can be used by `ghci` as well:
- The `Binary` (from `ghc`) instance of `SmallArray` is moved to
`GHC.Utils.Binary`
- Util functions `replicateSmallArrayIO`, `mapSmallArrayIO`,
`mapSmallArrayM_`, `imapSmallArrayM_` , `smallArrayFromList` and
`smallArrayToList` are added
- The `Show` instance is added
- The `Binary` (from `binary`) instance is added
- - - - -
fdf828ae by Cheng Shao at 2026-03-26T03:57:03-04:00
compiler: use `Binary` instance of `BCOByteArray` for bytecode objects
This commit defines `Binary` (from `compiler`) instance of
`BCOByteArray` which serializes the underlying buffer directly, and
uses it directly in bytecode object serialization. Previously we reuse
the `Binary` (from `binary`) instance, and this change allows us to
avoid double-copying via an intermediate `ByteString` when using
`put`/`get` in `binnary`. Also see added comment for explanation.
- - - - -
3bf62d0a by Cheng Shao at 2026-03-26T03:57:03-04:00
ghci: use SmallArray directly in ResolvedBCO
This patch makes ghci use `SmallArray` directly in `ResolvedBCO` when
applicable, making the memory representation more compact and reducing
marshaling overhead. Closes #27058.
- - - - -
3d6492ce by Wen Kokke at 2026-03-26T03:57:53-04:00
Fix race condition between flushEventLog and start/endEventLogging.
This commit changes `flushEventLog` to acquire/release the `state_change` mutex to prevent interleaving with `startEventLogging` and `endEventLogging`. In the current RTS, `flushEventLog` _does not_ acquire this mutex, which may lead to eventlog corruption on the following interleaving:
- `startEventLogging` writes the new `EventLogWriter` to `event_log_writer`.
- `flushEventLog` flushes some events to `event_log_writer`.
- `startEventLogging` writes the eventlog header to `event_log_writer`.
This causes the eventlog to be written out in an unreadable state, with one or more events preceding the eventlog header.
This commit renames the old function to `flushEventLog_` and defines `flushEventLog` simply as:
```c
void flushEventLog(Capability **cap USED_IF_THREADS)
{
ACQUIRE_LOCK(&state_change_mutex);
flushEventLog_(cap);
RELEASE_LOCK(&state_change_mutex);
}
```
The old function is still needed internally within the compilation unit, where it is used in `endEventLogging` in a context where the `state_change` mutex has already been acquired. I've chosen to mark `flushEventLog_` as static and let other uses of `flushEventLog` within the RTS refer to the new version. There is one use in `hs_init_ghc` via `flushTrace`, where the new locking behaviour should be harmless, and one use in `handle_tick`, which I believe was likely vulnerable to the same race condition, so the new locking behaviour is desirable.
I have not added a test. The behaviour is highly non-deterministic and requires a program that concurrently calls `flushEventLog` and `startEventLogging`/`endEventLogging`. I encountered the issue while developing `eventlog-socket` and within that context have verified that my patch likely addresses the issue: a test that used to fail within the first dozen or so runs now has been running on repeat for several hours.
- - - - -
7b9a75f0 by Phil Hazelden at 2026-03-26T03:58:37-04:00
Fix build with werror on glibc 2.43.
We've been defining `_XOPEN_SOURCE` and `_POSIX_C_SOURCE` to the same
values as defined in glibc prior to 2.43. But in 2.43, glibc changes
them to new values, which means we get a warning when redefining them.
By `#undef`ing them first, we no longer get a warning.
Closes #27076.
- - - - -
fe6e76c5 by Tobias Haslop at 2026-03-26T03:59:30-04:00
Fix broken Haddock link to Bifunctor class in description of Functor class
- - - - -
404b71c1 by Luite Stegeman at 2026-03-27T04:40:49-04:00
Fix assert in Interpreter.c
If we skip exactly the number of words on the stack we end up on
the first word in the next chunk.
- - - - -
a85bd503 by Luite Stegeman at 2026-03-27T04:40:49-04:00
Support arbitrary size unboxed tuples in bytecode
This stores the size (number of words on the stack) of the next
expected tuple in the TSO, ctoi_spill_size field, eliminating
the need of stg_ctoi_tN frames for each size.
Note: On 32 bit platform there is still a bytecode tuple size
limit of 255 words on the stack.
Fixes #26946
- - - - -
e2209031 by Luite Stegeman at 2026-03-27T04:40:49-04:00
Add specialized frames for small tuples
Small tuples are now returned more efficiently to the interpreter.
They use one less word of stack space and don't need manipulation
of the TSO anymore.
- - - - -
b26bb2ea by VeryMilkyJoe at 2026-03-27T04:41:38-04:00
Remove backwards compatibility pattern synonym `ModLocation`
Fixes #24932
- - - - -
66e5e324 by Vladislav Zavialov at 2026-03-27T04:42:25-04:00
Extend HsExpr with the StarIsType syntax (#26587, #26967)
This patch allows kinds of the form `k -> *` and `* -> k` to occur in
expression syntax, i.e. to be used as required type arguments.
For example:
{-# LANGUAGE RequiredTypeArguments, StarIsType #-}
x1 = f (* -> * -> *)
x2 = f (forall k. k -> *)
x3 = f ((* -> *) -> Constraint)
Summary of the changes:
* Introduce the HsStar constructor of HsExpr and its extension field XStar.
It is analogous to HsStarTy in HsType.
* Refactor HsStarTy to store the unicode flag as TokStar, defined as
type TokStar = EpUniToken "*" "★" -- similar to TokForall, TokRArrow, etc.
The token is stored in the extension field and replaces the Bool field.
* Extend the `infixexp2` nonterminal to parse `*` as a direct argument of `->`.
This is more limited than the full StarIsType syntax, but has the nice
property of not conflicting with the multiplication operator `a * b`.
Test case: T26967 T26967_tyop
- - - - -
f8de456f by Sylvain Henry at 2026-03-27T04:43:22-04:00
STM: don't create a transaction in the rhs of catchRetry# (#26028)
We don't need to create a transaction for the rhs of (catchRetry#)
because contrary to the lhs we don't need to abort it on retry. Moreover
it is particularly harmful if we have code such as (#26028):
let cN = readTVar vN >> retry
tree = c1 `orElse` (c2 `orElse` (c3 `orElse` ...))
atomically tree
Because it will stack transactions for the rhss and the read-sets of all
the transactions will be iteratively merged in O(n^2) after the
execution of the most nested retry.
This is the second attempt at implementing this. The first attempt
triggered segfaults (#26291) and has been reverted.
Co-Authored-By: Claude Sonnet 4.6 <noreply(a)anthropic.com>
- - - - -
fcf092dd by Luite Stegeman at 2026-03-27T04:44:17-04:00
Windows: remove StgAsyncIOResult and fix crash/leaks
In stg_block_async{_void}, a stack slot was reserved for
an StgAsyncIOResult. This slot would be filled by the IO
manager upon completion of the async call.
However, if the blocked thread was interrupted by an async
exception, we would end up in an invalid state:
- If the blocked computation was never re-entered, the
StgAsyncIOResult would never be freed.
- If the blocked computation was re-entered, the thread would
find an unitialized stack slot for the StgAsyncIOResult,
leading to a crash reading its fields, or freeing the pointer.
We fix this by removing the StgAsyncIOResult altogether and writing
the result directly to the stack.
Fixes #26341
- - - - -
05094993 by Luite Stegeman at 2026-03-27T04:45:12-04:00
Don't refine DEFAULT alt for unary typeclasses
A non-DEFAULT data alt for a unary typeclass dictionary would
interfere with Unary Class Magic, leading to segfaults.
fixes #27071
- - - - -
4ee260cf by sheaf at 2026-03-27T04:46:06-04:00
Fix several oversights in hsExprType
This commit fixes several oversights in GHC.Hs.Syn.Type.hsExprType:
- The 'RecordCon' case was returning the type of the constructor,
instead of the constructor application. This is fixed by using
'splitFunTys'.
- The 'ExplicitTuple' case failed to take into account tuple sections,
and was also incorrectly handling 1-tuples (e.g. 'Solo') which can
be constructed using Template Haskell.
- The 'NegApp' case was returning the type of the negation operator,
again failing to apply it to the argument. Fixed by using
'funResultTy'.
- The 'HsProc' case was computing the result type of the arrow proc
block, without taking into account the argument type. Fix that by
adding a new field to 'CmdTopTc' that stores the arrow type, so that
we can construct the correct result type `arr a b` for
`proc (pat :: a) -> (cmd :: b)`.
- The 'ArithSeq' and 'NegApp' cases were failing to take into account
the result 'HsWrapper', which could e.g. silently drop casts.
This is fixed by introducing 'syntaxExpr_wrappedFunResTy' which, on
top of taking the result type, applies the result 'HsWrapper'.
These fixes are validated by the new GHC API test T26910.
Fixes #26910
- - - - -
e97232ce by Hai at 2026-03-27T04:47:04-04:00
Parser.y: avoid looking at token with QualifiedDo
This changes the behavior of 'hintQualifiedDo' so that the supplied
token is not inspected when the QualifiedDo language extension bit is
set.
- - - - -
9831385b by Vladislav Zavialov at 2026-03-27T17:22:30-04:00
Infix holes in types (#11107)
This patch introduces several improvements that follow naturally from
refactoring HsOpTy to represent the operator as an HsType, aligning it
with the approach taken by OpApp and HsExpr.
User-facing changes:
1. Infix holes (t1 `_` t2) are now permitted in types, following the
precedent set by term-level expressions.
Test case: T11107
2. Error messages for illegal promotion ticks are now reported at more
precise source locations.
Test case: T17865
Internal changes:
* The definition of HsOpTy now mirrors that of OpApp:
| HsOpTy (XOpTy p) (LHsType p) (LHsType p) (LHsType p)
| OpApp (XOpApp p) (LHsExpr p) (LHsExpr p) (LHsExpr p)
This moves us one step closer to unifying HsType and HsExpr.
* Ignoring locations,
the old pattern match (HsOpTy x prom lhs op rhs)
is now written as (HsOpTy x lhs (HsTyVar x' prom op) rhs)
but we also handle (HsOpTy x lhs (HsWildCardTy x') rhs)
Constructors other than HsTyVar and HsWildCardTy never appear
in the operator position.
* The various definitions across the compiler have been updated to work
with the new representation, drawing inspiration from the term-level
pipeline where appropriate. For example,
ppr_infix_ty <=> ppr_infix_expr
get_tyop <=> get_op
lookupTypeFixityRn <=> lookupExprFixityRn
(the latter is factored out from rnExpr)
Test cases: T11107 T17865
- - - - -
5b6757d7 by mangoiv at 2026-03-27T17:23:19-04:00
ci: build i386 non-validate for deb12
This is a small fix that will unlock ghcup metadata to run, i386 debian
12 was missing as a job.
- - - - -
cf942119 by Cheng Shao at 2026-03-30T15:24:37-04:00
ghc-boot: remove unused SizedSeq instances and functions
This commit removes unused `SizedSeq` instances and functions, only
keeping the bits we need for hpc tick sequence for now.
- - - - -
22c5b7cc by Cheng Shao at 2026-03-30T15:24:38-04:00
ghci: remove unused GHCi.BinaryArray
This patch removes the unused `GHCi.BinaryArray` module from `ghci`.
Closes #27108.
- - - - -
77abb4ab by Cheng Shao at 2026-03-30T15:25:21-04:00
testsuite: mark T17912 as fragile on Windows
T17912 is still fragile on Windows, it sometimes unexpectedly pass in
CI. This especially strains our already scarce Windows CI runner
resources. Mark it as fragile on Windows for the time being.
- - - - -
d741a6cc by Andreas Klebinger at 2026-03-31T04:39:33-04:00
Bump minimum shake version for hadrian.
We also add the shake version we want to stack.yaml
Fixes #26884
- - - - -
5e556f9e by Vladislav Zavialov at 2026-03-31T04:40:16-04:00
Status check for the HsType~HsExpr refactoring (#25121)
Add a test case to track the status of a refactoring project within GHC
whose goal is to arrive at the following declaration:
type HsType = HsExpr
The rationale for this is to increase code reuse between the term- and
type-level code in the compiler front-end (AST, parser, renamer, type checker).
The status report is saved to testsuite/tests/ghc-api/T25121_status.stdout
and provides useful insights into what needs to happen to make progress on
the ticket.
- - - - -
acffb1b1 by fendor at 2026-03-31T04:41:02-04:00
Extract Binary instances to `GHC.ByteCode.Binary`
- - - - -
e2ea8e25 by fendor at 2026-03-31T04:41:02-04:00
Add `seqNonEmpty` for evaluating `NonEmpty a`
- - - - -
048b00b7 by fendor at 2026-03-31T04:41:02-04:00
Record `LinkableUsage` instead of `Linkable` in `LoaderState`
Retaining a ByteCode `Linkable` after it has been loaded retains its
`UnlinkedBCO`, keeping it alive for the remainder of the program.
This starts accumulating a lot of `UnlinkedBCO` and memory over time.
However, the `Linkable` is merely used to later record its usage in
`mkObjectUsage`, which is used for recompilation checking.
However, this is incorrect, as the interface file and bytecode objects
could be in different states, e.g. the interface changes, but the
bytecode library hasn't changed so we don't need to recompile and vice
versa.
By computing a `Fingerprint` for the `ModuleByteCode`, and recording it
in the `LinkableUsage`, we know precisely whether the `ByteCode` object
on disk is outdated.
Thus, parts of this commit just makes sure that we efficiently compute a
`Fingerprint` for `ModuleByteCode` and store it in the on-disk
representation of `ModuleByteCode`.
We change the `LoaderState` to retain `LinkableUsage`, which is smaller
representation of a `Linkable`. This allows us to free the unneeded
fields of `Linkable` after linking them.
We declare the following memory invariants that this commit implements:
* No `LinkablePart` should be retained from `LoaderState`.
* `Linkable`s should be unloaded after they have been loaded.
These invariants are unfortunately tricky to automatically uphold, so we
are simply documenting our assumptions for now.
We introduce the `linkable-space` test which makes sure that after
loading, no `DotGBC` or `UnlinkedBCO` is retained.
-------------------------
Metric Increase:
MultiLayerModulesTH_OneShot
-------------------------
We allocate a bit more, but the peak number of bytes doesn't change.
While a bit unfortunate, accepting the metric increase.
We add multiple new performance measurements where we were able to
observe the desired memory invariants. Further, we add regression tests
to validate that the recompilation checker behaves more correct than
before.
- - - - -
2d1c1997 by Simon Jakobi at 2026-03-31T04:41:46-04:00
Eliminate dictionary-passing in ListMap operations
Mark the ListMap helpers 'INLINABLE' so importing modules can specialise
the 'TrieMap (ListMap m)' methods and avoid recursive dictionary-passing.
See Note [Making ListMap operations specialisable].
Fixes #27097
- - - - -
ed2c6570 by Cheng Shao at 2026-03-31T04:42:33-04:00
testsuite: fix testdir cleanup logic on Windows
testdir cleanup is unreliable on Windows (#13162) and despite existing
hacks in the driver, new failure mode has occurred. This patch makes
it print the warning and carry on when failed to clean up a testdir,
instead of reporting a spurious framework failure. See added comment
for detailed explanation.
- - - - -
d9388e29 by Simon Jakobi at 2026-03-31T13:14:59-04:00
Add regression test for #18177
Closes #18177.
Assisted-by: Codex
- - - - -
6a10045c by mangoiv at 2026-03-31T13:15:43-04:00
ci: allow metric decrease for two tests on i386
There has been a nightly failure on i386 due to a compiler runtime
improvement on i386 debian 12. We allow that.
Metric Decrease (test_env='i386-linux-deb12'):
T12707 T8095
- - - - -
7fbb4fcb by Rodrigo Mesquita at 2026-04-01T12:16:33+00:00
Bump default language edition to GHC2024
As per the accepted ghc-proposal#632
Fixes #26039
- - - - -
5ae43275 by Peng Fan at 2026-04-01T19:01:06-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
- - - - -
8f95534a by Duncan Coutts at 2026-04-01T19:01:52-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.
- - - - -
51b32b0d by Duncan Coutts at 2026-04-01T19:01:52-04:00
Tidy up some timer/ticker comments elsewhere
- - - - -
7562bcd7 by Duncan Coutts at 2026-04-01T19:01:52-04:00
Remove now-unused install_vtalrm_handler
Support function used by both of the signal-based ticker
implementations.
- - - - -
6da127c7 by Duncan Coutts at 2026-04-01T19:01:52-04:00
No longer probe for timer_create in rts/configure
It was only used by the TimerCreate.c ticker impl.
- - - - -
3fd490fa by Duncan Coutts at 2026-04-01T19:01:53-04:00
Note that rtsTimerSignal is deprecated.
- - - - -
63099b0f by Simon Jakobi at 2026-04-01T19:02:39-04:00
Add perf test for #13960
Closes #13960.
- - - - -
4294e2ad by fendor at 2026-04-02T10:56:35+02:00
Make HPC work with bytecode interpreter
Add support to generate .tix files from bytecode objects and the
bytecode interpreter.
Conceptually, we insert HPC ticks into the bytecode similar to how we insert
breakpoints.
HPC and breakpoints do not share the same tick array but we use a separate
tick-array for hpc/breakpoint ticks during bytecode generation.
We teach the bytecode interpreter to handle hpc ticks.
The implementation is quite trivial, simply increment the counter in the
global hpc_ticks array for the respective module.
This hpc_ticks array is generated as part of the `CStub`, so we can rely
on it existing.
A tricky bit is "registering" a bytecode object for HPC instrumentation.
In the compiled case, this is achieved via CStub and initializer/finalizers
`.init` sections which are called when the executable is run.
After the initializers have been invoked, which is before `hs_init_ghc`,
we then call `startup_hpc` in `hs_init_ghc` iff any modules were "registered"
for hpc instrumentation via `hs_hpc_module`.
Since bytecode objects are loaded after starting up GHCi, this workflow
doesn't work for supporting `hpc` and the `hpc` run-time is never
started, even if a module is added for instrumentation.
We fix this issue by employing the same technique as is for `SptEntry`s:
* We introduce a new field to `CompiledByteCode`, called `ByteCodeHpcInfo`
which contains enough information to call `hs_hpc_module`, allowing us to
register the module for `hpc` instrumentation`.
* After registering the module, we unconditionally call `startupHpc`, to make
sure the .tix file is written.
Calling `startupHpc` multiple times is safe.
Calling `hs_hpc_module` multiple times for the same module is also safe.
Evaluating a bytecode object instrumented with `-fhpc` without registering it
in the `hpc` run-time will simply not generate any `.tix` files for this
bytecode object.
Closes #27036
- - - - -
814 changed files:
- .gitlab-ci.yml
- .gitlab/ci.sh
- .gitlab/generate-ci/flake.lock
- .gitlab/generate-ci/gen_ci.hs
- + .gitlab/issue_templates/release_tracking.md
- .gitlab/jobs.yaml
- .gitlab/rel_eng/fetch-gitlab-artifacts/fetch_gitlab.py
- .gitlab/rel_eng/mk-ghcup-metadata/mk_ghcup_metadata.py
- compiler/CodeGen.Platform.h
- compiler/GHC.hs
- compiler/GHC/Builtin/Names.hs
- compiler/GHC/ByteCode/Asm.hs
- + compiler/GHC/ByteCode/Binary.hs
- compiler/GHC/ByteCode/Instr.hs
- compiler/GHC/ByteCode/Linker.hs
- + compiler/GHC/ByteCode/Recomp/Binary.hs
- compiler/GHC/ByteCode/Serialize.hs
- compiler/GHC/ByteCode/Types.hs
- compiler/GHC/Cmm/CommonBlockElim.hs
- compiler/GHC/Cmm/Expr.hs
- compiler/GHC/Cmm/Node.hs
- compiler/GHC/Cmm/Opt.hs
- compiler/GHC/Cmm/Parser.y
- compiler/GHC/Cmm/Type.hs
- compiler/GHC/Cmm/Utils.hs
- compiler/GHC/CmmToAsm/AArch64/CodeGen.hs
- compiler/GHC/CmmToAsm/AArch64/Instr.hs
- compiler/GHC/CmmToAsm/AArch64/Ppr.hs
- compiler/GHC/CmmToAsm/AArch64/Regs.hs
- compiler/GHC/CmmToAsm/LA64/CodeGen.hs
- compiler/GHC/CmmToAsm/LA64/Instr.hs
- compiler/GHC/CmmToAsm/LA64/Ppr.hs
- compiler/GHC/CmmToAsm/LA64/Regs.hs
- compiler/GHC/CmmToAsm/PPC/CodeGen.hs
- compiler/GHC/CmmToAsm/PPC/Ppr.hs
- compiler/GHC/CmmToAsm/PPC/Regs.hs
- compiler/GHC/CmmToAsm/RV64/CodeGen.hs
- compiler/GHC/CmmToAsm/RV64/Ppr.hs
- compiler/GHC/CmmToAsm/RV64/Regs.hs
- compiler/GHC/CmmToAsm/Reg/Graph/TrivColorable.hs
- compiler/GHC/CmmToAsm/Wasm/FromCmm.hs
- compiler/GHC/CmmToAsm/X86/CodeGen.hs
- compiler/GHC/CmmToAsm/X86/Ppr.hs
- compiler/GHC/CmmToAsm/X86/Regs.hs
- compiler/GHC/CmmToC.hs
- compiler/GHC/CmmToLlvm.hs
- compiler/GHC/CmmToLlvm/CodeGen.hs
- compiler/GHC/CmmToLlvm/Config.hs
- compiler/GHC/CmmToLlvm/Data.hs
- compiler/GHC/CmmToLlvm/Mangler.hs
- compiler/GHC/Core.hs
- compiler/GHC/Core/Lint.hs
- compiler/GHC/Core/Make.hs
- compiler/GHC/Core/Opt/ConstantFold.hs
- + compiler/GHC/Core/Opt/Range.hs
- compiler/GHC/Core/Opt/Simplify/Iteration.hs
- compiler/GHC/Core/TyCon.hs
- compiler/GHC/Core/Utils.hs
- compiler/GHC/CoreToStg/AddImplicitBinds.hs
- compiler/GHC/Data/TrieMap.hs
- compiler/GHC/Driver/Backend.hs
- compiler/GHC/Driver/CodeOutput.hs
- compiler/GHC/Driver/Config/CmmToLlvm.hs
- compiler/GHC/Driver/Config/StgToCmm.hs
- compiler/GHC/Driver/Downsweep.hs
- compiler/GHC/Driver/Flags.hs
- compiler/GHC/Driver/Hooks.hs
- compiler/GHC/Driver/Main.hs
- compiler/GHC/Driver/Pipeline.hs
- compiler/GHC/Driver/Plugins.hs
- compiler/GHC/Driver/Session.hs
- compiler/GHC/Hs/Expr.hs
- compiler/GHC/Hs/Syn/Type.hs
- compiler/GHC/Hs/Type.hs
- compiler/GHC/Hs/Utils.hs
- compiler/GHC/HsToCore.hs
- compiler/GHC/HsToCore/Arrows.hs
- compiler/GHC/HsToCore/Coverage.hs
- compiler/GHC/HsToCore/Expr.hs
- compiler/GHC/HsToCore/Foreign/C.hs
- compiler/GHC/HsToCore/Match/Literal.hs
- compiler/GHC/HsToCore/Pmc.hs
- compiler/GHC/HsToCore/Pmc/Solver/Types.hs
- compiler/GHC/HsToCore/Quote.hs
- compiler/GHC/HsToCore/Ticks.hs
- compiler/GHC/HsToCore/Usage.hs
- compiler/GHC/Iface/Ext/Ast.hs
- compiler/GHC/Iface/Recomp.hs
- compiler/GHC/Iface/Recomp/Types.hs
- compiler/GHC/Iface/Tidy.hs
- compiler/GHC/Iface/Type.hs
- compiler/GHC/Linker/ByteCode.hs
- compiler/GHC/Linker/Deps.hs
- compiler/GHC/Linker/Loader.hs
- compiler/GHC/Linker/Types.hs
- compiler/GHC/Parser.y
- compiler/GHC/Parser/Annotation.hs
- compiler/GHC/Parser/Errors/Types.hs
- compiler/GHC/Parser/PostProcess.hs
- + compiler/GHC/Platform/Tag.hs
- compiler/GHC/Prelude/Basic.hs
- compiler/GHC/Rename/Expr.hs
- compiler/GHC/Rename/Fixity.hs
- compiler/GHC/Rename/HsType.hs
- compiler/GHC/Rename/Pat.hs
- compiler/GHC/Runtime/Interpreter.hs
- compiler/GHC/Runtime/Loader.hs
- compiler/GHC/Stg/Unarise.hs
- compiler/GHC/StgToByteCode.hs
- compiler/GHC/StgToCmm/Closure.hs
- compiler/GHC/StgToCmm/Expr.hs
- compiler/GHC/StgToCmm/Lit.hs
- compiler/GHC/StgToCmm/Prim.hs
- compiler/GHC/StgToCmm/Utils.hs
- compiler/GHC/StgToJS/Literal.hs
- compiler/GHC/Tc/Errors.hs
- compiler/GHC/Tc/Errors/Ppr.hs
- compiler/GHC/Tc/Errors/Types.hs
- compiler/GHC/Tc/Gen/App.hs
- compiler/GHC/Tc/Gen/Arrow.hs
- compiler/GHC/Tc/Gen/Expr.hs
- compiler/GHC/Tc/Gen/HsType.hs
- compiler/GHC/Tc/Gen/Pat.hs
- compiler/GHC/Tc/Gen/Sig.hs
- compiler/GHC/Tc/Instance/Class.hs
- compiler/GHC/Tc/TyCl/Build.hs
- compiler/GHC/Tc/Types.hs
- compiler/GHC/Tc/Types/Origin.hs
- compiler/GHC/Tc/Utils/Monad.hs
- compiler/GHC/Tc/Utils/Unify.hs
- compiler/GHC/Tc/Zonk/Type.hs
- compiler/GHC/ThToHs.hs
- compiler/GHC/Types/HpcInfo.hs
- compiler/GHC/Types/Id/Make.hs
- compiler/GHC/Types/Literal.hs
- + compiler/GHC/Types/Literal/Floating.hs
- compiler/GHC/Types/RepType.hs
- compiler/GHC/Unit/Home/ModInfo.hs
- compiler/GHC/Unit/Module/Deps.hs
- compiler/GHC/Unit/Module/Location.hs
- compiler/GHC/Unit/Module/ModGuts.hs
- compiler/GHC/Unit/Module/Status.hs
- compiler/GHC/Utils/Binary.hs
- compiler/GHC/Utils/Misc.hs
- compiler/GHC/Utils/Outputable.hs
- compiler/Language/Haskell/Syntax/Expr.hs
- compiler/Language/Haskell/Syntax/Extension.hs
- compiler/Language/Haskell/Syntax/Type.hs
- compiler/ghc.cabal.in
- docs/users_guide/9.16.1-notes.rst
- docs/users_guide/exts/control.rst
- docs/users_guide/exts/required_type_arguments.rst
- docs/users_guide/ghci.rst
- docs/users_guide/utils.py
- ghc/GHCi/Leak.hs
- ghc/GHCi/UI.hs
- ghc/Main.hs
- hadrian/cabal.project
- hadrian/hadrian.cabal
- hadrian/src/Settings/Flavours/GhcInGhci.hs
- hadrian/src/Settings/Flavours/Validate.hs
- hadrian/src/Settings/Packages.hs
- hadrian/stack.yaml
- libraries/base/src/Control/Applicative.hs
- libraries/base/src/Data/Char.hs
- libraries/base/src/Data/Eq.hs
- libraries/base/src/Data/Semigroup.hs
- libraries/base/src/GHC/Base.hs
- libraries/base/src/GHC/Weak/Finalize.hs
- libraries/base/src/Prelude.hs
- libraries/base/tests/IO/all.T
- libraries/ghc-boot/GHC/Data/SizedSeq.hs
- compiler/GHC/Data/SmallArray.hs → libraries/ghc-boot/GHC/Data/SmallArray.hs
- libraries/ghc-boot/ghc-boot.cabal.in
- libraries/ghc-experimental/ghc-experimental.cabal.in
- libraries/ghc-experimental/src/GHC/Profiling/Eras.hs
- + libraries/ghc-experimental/src/GHC/Stack/Decode/Experimental.hs
- libraries/ghc-internal/codepages/MakeTable.hs
- libraries/ghc-internal/ghc-internal.cabal.in
- libraries/ghc-internal/src/GHC/Internal/AllocationLimitHandler.hs
- libraries/ghc-internal/src/GHC/Internal/Arr.hs
- libraries/ghc-internal/src/GHC/Internal/Base.hs
- libraries/ghc-internal/src/GHC/Internal/Bits.hs
- libraries/ghc-internal/src/GHC/Internal/ByteOrder.hs
- − libraries/ghc-internal/src/GHC/Internal/ByteOrder.hs-boot
- libraries/ghc-internal/src/GHC/Internal/Char.hs
- libraries/ghc-internal/src/GHC/Internal/Clock.hsc
- libraries/ghc-internal/src/GHC/Internal/ClosureTypes.hs
- libraries/ghc-internal/src/GHC/Internal/Conc/Bound.hs
- libraries/ghc-internal/src/GHC/Internal/Conc/IO.hs
- libraries/ghc-internal/src/GHC/Internal/Conc/POSIX.hs
- libraries/ghc-internal/src/GHC/Internal/Conc/Signal.hs
- libraries/ghc-internal/src/GHC/Internal/Conc/Sync.hs
- libraries/ghc-internal/src/GHC/Internal/Conc/Windows.hs
- libraries/ghc-internal/src/GHC/Internal/ConsoleHandler.hsc
- libraries/ghc-internal/src/GHC/Internal/Control/Arrow.hs
- libraries/ghc-internal/src/GHC/Internal/Control/Concurrent/MVar.hs
- libraries/ghc-internal/src/GHC/Internal/Control/Exception.hs
- libraries/ghc-internal/src/GHC/Internal/Control/Exception/Base.hs
- libraries/ghc-internal/src/GHC/Internal/Control/Monad.hs
- libraries/ghc-internal/src/GHC/Internal/Control/Monad/Fail.hs
- libraries/ghc-internal/src/GHC/Internal/Control/Monad/Fix.hs
- libraries/ghc-internal/src/GHC/Internal/Control/Monad/IO/Class.hs
- libraries/ghc-internal/src/GHC/Internal/Control/Monad/ST/Imp.hs
- libraries/ghc-internal/src/GHC/Internal/Control/Monad/ST/Lazy/Imp.hs
- libraries/ghc-internal/src/GHC/Internal/Data/Bits.hs
- libraries/ghc-internal/src/GHC/Internal/Data/Data.hs
- libraries/ghc-internal/src/GHC/Internal/Data/Dynamic.hs
- libraries/ghc-internal/src/GHC/Internal/Data/Either.hs
- − libraries/ghc-internal/src/GHC/Internal/Data/Eq.hs
- libraries/ghc-internal/src/GHC/Internal/Data/Foldable.hs
- libraries/ghc-internal/src/GHC/Internal/Data/Function.hs
- libraries/ghc-internal/src/GHC/Internal/Data/Functor/Const.hs
- libraries/ghc-internal/src/GHC/Internal/Data/Functor/Identity.hs
- libraries/ghc-internal/src/GHC/Internal/Data/Functor/Utils.hs
- libraries/ghc-internal/src/GHC/Internal/Data/IORef.hs
- libraries/ghc-internal/src/GHC/Internal/Data/List.hs
- libraries/ghc-internal/src/GHC/Internal/Data/Maybe.hs
- libraries/ghc-internal/src/GHC/Internal/Data/Monoid.hs
- libraries/ghc-internal/src/GHC/Internal/Data/OldList.hs
- libraries/ghc-internal/src/GHC/Internal/Data/Ord.hs
- libraries/ghc-internal/src/GHC/Internal/Data/Proxy.hs
- libraries/ghc-internal/src/GHC/Internal/Data/STRef.hs
- libraries/ghc-internal/src/GHC/Internal/Data/Semigroup/Internal.hs
- libraries/ghc-internal/src/GHC/Internal/Data/String.hs
- libraries/ghc-internal/src/GHC/Internal/Data/Traversable.hs
- libraries/ghc-internal/src/GHC/Internal/Data/Type/Bool.hs
- libraries/ghc-internal/src/GHC/Internal/Data/Type/Coercion.hs
- libraries/ghc-internal/src/GHC/Internal/Data/Type/Equality.hs
- libraries/ghc-internal/src/GHC/Internal/Data/Type/Ord.hs
- libraries/ghc-internal/src/GHC/Internal/Data/Typeable.hs
- libraries/ghc-internal/src/GHC/Internal/Data/Typeable/Internal.hs
- libraries/ghc-internal/src/GHC/Internal/Data/Unique.hs
- libraries/ghc-internal/src/GHC/Internal/Data/Version.hs
- libraries/ghc-internal/src/GHC/Internal/Debug/Trace.hs
- libraries/ghc-internal/src/GHC/Internal/Debug/Trace.hs-boot
- libraries/ghc-internal/src/GHC/Internal/Encoding/UTF8.hs
- libraries/ghc-internal/src/GHC/Internal/Enum.hs
- libraries/ghc-internal/src/GHC/Internal/Environment.hs
- libraries/ghc-internal/src/GHC/Internal/Event/Array.hs
- libraries/ghc-internal/src/GHC/Internal/Event/Control.hs
- libraries/ghc-internal/src/GHC/Internal/Event/EPoll.hsc
- libraries/ghc-internal/src/GHC/Internal/Event/IntVar.hs
- libraries/ghc-internal/src/GHC/Internal/Event/Internal.hs
- libraries/ghc-internal/src/GHC/Internal/Event/Internal/Types.hs
- libraries/ghc-internal/src/GHC/Internal/Event/KQueue.hsc
- libraries/ghc-internal/src/GHC/Internal/Event/Manager.hs
- libraries/ghc-internal/src/GHC/Internal/Event/PSQ.hs
- libraries/ghc-internal/src/GHC/Internal/Event/Poll.hsc
- libraries/ghc-internal/src/GHC/Internal/Event/Thread.hs
- libraries/ghc-internal/src/GHC/Internal/Event/TimeOut.hs
- libraries/ghc-internal/src/GHC/Internal/Event/TimerManager.hs
- libraries/ghc-internal/src/GHC/Internal/Event/Unique.hs
- libraries/ghc-internal/src/GHC/Internal/Event/Windows.hsc
- libraries/ghc-internal/src/GHC/Internal/Event/Windows/Clock.hs
- libraries/ghc-internal/src/GHC/Internal/Event/Windows/ConsoleEvent.hsc
- libraries/ghc-internal/src/GHC/Internal/Event/Windows/FFI.hsc
- libraries/ghc-internal/src/GHC/Internal/Event/Windows/ManagedThreadPool.hs
- libraries/ghc-internal/src/GHC/Internal/Event/Windows/Thread.hs
- libraries/ghc-internal/src/GHC/Internal/Exception.hs
- libraries/ghc-internal/src/GHC/Internal/Exception/Backtrace.hs
- libraries/ghc-internal/src/GHC/Internal/Exception/Backtrace.hs-boot
- libraries/ghc-internal/src/GHC/Internal/Exception/Context.hs
- libraries/ghc-internal/src/GHC/Internal/Exception/Type.hs
- libraries/ghc-internal/src/GHC/Internal/ExecutionStack.hs
- libraries/ghc-internal/src/GHC/Internal/ExecutionStack/Internal.hsc
- libraries/ghc-internal/src/GHC/Internal/Exts.hs
- libraries/ghc-internal/src/GHC/Internal/Fingerprint.hs
- libraries/ghc-internal/src/GHC/Internal/Fingerprint.hs-boot
- libraries/ghc-internal/src/GHC/Internal/Fingerprint/Type.hs
- libraries/ghc-internal/src/GHC/Internal/Float.hs
- libraries/ghc-internal/src/GHC/Internal/Float/ConversionUtils.hs
- libraries/ghc-internal/src/GHC/Internal/Float/RealFracMethods.hs
- libraries/ghc-internal/src/GHC/Internal/Foreign/C/ConstPtr.hs
- libraries/ghc-internal/src/GHC/Internal/Foreign/C/Error.hs
- libraries/ghc-internal/src/GHC/Internal/Foreign/C/String.hs
- libraries/ghc-internal/src/GHC/Internal/Foreign/C/String/Encoding.hs
- libraries/ghc-internal/src/GHC/Internal/Foreign/C/Types.hs
- libraries/ghc-internal/src/GHC/Internal/Foreign/ForeignPtr/Imp.hs
- libraries/ghc-internal/src/GHC/Internal/Foreign/Marshal/Alloc.hs
- libraries/ghc-internal/src/GHC/Internal/Foreign/Marshal/Array.hs
- libraries/ghc-internal/src/GHC/Internal/Foreign/Marshal/Error.hs
- libraries/ghc-internal/src/GHC/Internal/Foreign/Marshal/Pool.hs
- libraries/ghc-internal/src/GHC/Internal/Foreign/Marshal/Utils.hs
- libraries/ghc-internal/src/GHC/Internal/Foreign/Ptr.hs
- libraries/ghc-internal/src/GHC/Internal/Foreign/Storable.hs
- libraries/ghc-internal/src/GHC/Internal/ForeignPtr.hs
- libraries/ghc-internal/src/GHC/Internal/ForeignSrcLang.hs
- libraries/ghc-internal/src/GHC/Internal/Functor/ZipList.hs
- libraries/ghc-internal/src/GHC/Internal/GHCi.hs
- libraries/ghc-internal/src/GHC/Internal/GHCi/Helpers.hs
- libraries/ghc-internal/src/GHC/Internal/Generics.hs
- libraries/ghc-internal/src/GHC/Internal/Heap/Closures.hs
- libraries/ghc-internal/src/GHC/Internal/Heap/InfoTable.hsc
- libraries/ghc-internal/src/GHC/Internal/Heap/InfoTable/Types.hsc
- libraries/ghc-internal/src/GHC/Internal/Heap/InfoTableProf.hsc
- libraries/ghc-internal/src/GHC/Internal/Heap/ProfInfo/Types.hs
- libraries/ghc-internal/src/GHC/Internal/IO.hs
- libraries/ghc-internal/src/GHC/Internal/IO/Buffer.hs
- libraries/ghc-internal/src/GHC/Internal/IO/BufferedIO.hs
- libraries/ghc-internal/src/GHC/Internal/IO/Device.hs
- libraries/ghc-internal/src/GHC/Internal/IO/Encoding.hs
- libraries/ghc-internal/src/GHC/Internal/IO/Encoding/CodePage.hs
- libraries/ghc-internal/src/GHC/Internal/IO/Encoding/CodePage/API.hs
- libraries/ghc-internal/src/GHC/Internal/IO/Encoding/CodePage/Table.hs
- libraries/ghc-internal/src/GHC/Internal/IO/Encoding/Failure.hs
- libraries/ghc-internal/src/GHC/Internal/IO/Encoding/Iconv.hs
- libraries/ghc-internal/src/GHC/Internal/IO/Encoding/Latin1.hs
- libraries/ghc-internal/src/GHC/Internal/IO/Encoding/Types.hs
- libraries/ghc-internal/src/GHC/Internal/IO/Encoding/UTF16.hs
- libraries/ghc-internal/src/GHC/Internal/IO/Encoding/UTF32.hs
- libraries/ghc-internal/src/GHC/Internal/IO/Encoding/UTF8.hs
- libraries/ghc-internal/src/GHC/Internal/IO/Exception.hs
- libraries/ghc-internal/src/GHC/Internal/IO/Exception.hs-boot
- libraries/ghc-internal/src/GHC/Internal/IO/FD.hs
- libraries/ghc-internal/src/GHC/Internal/IO/Handle.hs
- libraries/ghc-internal/src/GHC/Internal/IO/Handle/FD.hs
- libraries/ghc-internal/src/GHC/Internal/IO/Handle/Internals.hs
- libraries/ghc-internal/src/GHC/Internal/IO/Handle/Lock.hs
- libraries/ghc-internal/src/GHC/Internal/IO/Handle/Lock/Flock.hsc
- libraries/ghc-internal/src/GHC/Internal/IO/Handle/Lock/LinuxOFD.hsc
- libraries/ghc-internal/src/GHC/Internal/IO/Handle/Lock/NoOp.hs
- libraries/ghc-internal/src/GHC/Internal/IO/Handle/Lock/Windows.hsc
- libraries/ghc-internal/src/GHC/Internal/IO/Handle/Text.hs
- libraries/ghc-internal/src/GHC/Internal/IO/Handle/Types.hs
- libraries/ghc-internal/src/GHC/Internal/IO/Handle/Windows.hs
- libraries/ghc-internal/src/GHC/Internal/IO/IOMode.hs
- libraries/ghc-internal/src/GHC/Internal/IO/SubSystem.hs
- libraries/ghc-internal/src/GHC/Internal/IO/Unsafe.hs
- libraries/ghc-internal/src/GHC/Internal/IO/Windows/Encoding.hs
- libraries/ghc-internal/src/GHC/Internal/IO/Windows/Handle.hsc
- libraries/ghc-internal/src/GHC/Internal/IOArray.hs
- libraries/ghc-internal/src/GHC/Internal/IORef.hs
- libraries/ghc-internal/src/GHC/Internal/InfoProv.hs
- libraries/ghc-internal/src/GHC/Internal/InfoProv/Types.hsc
- libraries/ghc-internal/src/GHC/Internal/Int.hs
- libraries/ghc-internal/src/GHC/Internal/IsList.hs
- libraries/ghc-internal/src/GHC/Internal/Ix.hs
- libraries/ghc-internal/src/GHC/Internal/JS/Foreign/Callback.hs
- libraries/ghc-internal/src/GHC/Internal/JS/Prim/Internal.hs
- libraries/ghc-internal/src/GHC/Internal/JS/Prim/Internal/Build.hs
- libraries/ghc-internal/src/GHC/Internal/LanguageExtensions.hs
- libraries/ghc-internal/src/GHC/Internal/Lexeme.hs
- libraries/ghc-internal/src/GHC/Internal/List.hs
- libraries/ghc-internal/src/GHC/Internal/MVar.hs
- libraries/ghc-internal/src/GHC/Internal/Num.hs
- libraries/ghc-internal/src/GHC/Internal/Numeric.hs
- libraries/ghc-internal/src/GHC/Internal/OverloadedLabels.hs
- libraries/ghc-internal/src/GHC/Internal/Pack.hs
- libraries/ghc-internal/src/GHC/Internal/Profiling.hs
- libraries/ghc-internal/src/GHC/Internal/Ptr.hs
- libraries/ghc-internal/src/GHC/Internal/RTS/Flags.hsc
- libraries/ghc-internal/src/GHC/Internal/RTS/Flags/Test.hsc
- libraries/ghc-internal/src/GHC/Internal/Read.hs
- libraries/ghc-internal/src/GHC/Internal/Real.hs
- libraries/ghc-internal/src/GHC/Internal/ST.hs
- libraries/ghc-internal/src/GHC/Internal/STM.hs
- libraries/ghc-internal/src/GHC/Internal/STRef.hs
- libraries/ghc-internal/src/GHC/Internal/Show.hs
- libraries/ghc-internal/src/GHC/Internal/Stable.hs
- libraries/ghc-internal/src/GHC/Internal/StableName.hs
- libraries/ghc-internal/src/GHC/Internal/Stack.hs
- libraries/ghc-internal/src/GHC/Internal/Stack.hs-boot
- libraries/ghc-internal/src/GHC/Internal/Stack/Annotation.hs
- libraries/ghc-internal/src/GHC/Internal/Stack/CCS.hsc
- libraries/ghc-internal/src/GHC/Internal/Stack/CloneStack.hs
- libraries/ghc-internal/src/GHC/Internal/Stack/Constants.hsc
- libraries/ghc-internal/src/GHC/Internal/Stack/ConstantsProf.hsc
- libraries/ghc-internal/src/GHC/Internal/Stack/Decode.hs
- libraries/ghc-internal/src/GHC/Internal/StaticPtr.hs
- libraries/ghc-internal/src/GHC/Internal/StaticPtr/Internal.hs
- libraries/ghc-internal/src/GHC/Internal/Stats.hsc
- libraries/ghc-internal/src/GHC/Internal/Storable.hs
- libraries/ghc-internal/src/GHC/Internal/System/Environment.hs
- libraries/ghc-internal/src/GHC/Internal/System/Environment/Blank.hsc
- libraries/ghc-internal/src/GHC/Internal/System/Environment/ExecutablePath.hsc
- libraries/ghc-internal/src/GHC/Internal/System/IO.hs
- libraries/ghc-internal/src/GHC/Internal/System/IO/Error.hs
- libraries/ghc-internal/src/GHC/Internal/System/Mem.hs
- libraries/ghc-internal/src/GHC/Internal/System/Posix/Internals.hs
- libraries/ghc-internal/src/GHC/Internal/System/Posix/Types.hs
- libraries/ghc-internal/src/GHC/Internal/TH/Lib.hs
- libraries/ghc-internal/src/GHC/Internal/TH/Lift.hs
- libraries/ghc-internal/src/GHC/Internal/TH/Monad.hs
- libraries/ghc-internal/src/GHC/Internal/TH/Syntax.hs
- libraries/ghc-internal/src/GHC/Internal/Text/ParserCombinators/ReadP.hs
- libraries/ghc-internal/src/GHC/Internal/Text/ParserCombinators/ReadPrec.hs
- libraries/ghc-internal/src/GHC/Internal/Text/Read.hs
- libraries/ghc-internal/src/GHC/Internal/Text/Read/Lex.hs
- libraries/ghc-internal/src/GHC/Internal/TopHandler.hs
- libraries/ghc-internal/src/GHC/Internal/TypeLits.hs
- libraries/ghc-internal/src/GHC/Internal/TypeLits/Internal.hs
- libraries/ghc-internal/src/GHC/Internal/TypeNats.hs
- libraries/ghc-internal/src/GHC/Internal/TypeNats/Internal.hs
- libraries/ghc-internal/src/GHC/Internal/Unicode.hs
- libraries/ghc-internal/src/GHC/Internal/Unicode/Bits.hs
- libraries/ghc-internal/src/GHC/Internal/Unicode/Char/DerivedCoreProperties.hs
- libraries/ghc-internal/src/GHC/Internal/Unicode/Char/UnicodeData/GeneralCategory.hs
- libraries/ghc-internal/src/GHC/Internal/Unicode/Char/UnicodeData/SimpleLowerCaseMapping.hs
- libraries/ghc-internal/src/GHC/Internal/Unicode/Char/UnicodeData/SimpleTitleCaseMapping.hs
- libraries/ghc-internal/src/GHC/Internal/Unicode/Char/UnicodeData/SimpleUpperCaseMapping.hs
- libraries/ghc-internal/src/GHC/Internal/Unsafe/Coerce.hs
- libraries/ghc-internal/src/GHC/Internal/Wasm/Prim/Conc.hs
- libraries/ghc-internal/src/GHC/Internal/Wasm/Prim/Conc/Internal.hs
- libraries/ghc-internal/src/GHC/Internal/Wasm/Prim/Exports.hs
- libraries/ghc-internal/src/GHC/Internal/Wasm/Prim/Flag.hs
- libraries/ghc-internal/src/GHC/Internal/Wasm/Prim/Imports.hs
- libraries/ghc-internal/src/GHC/Internal/Wasm/Prim/Types.hs
- libraries/ghc-internal/src/GHC/Internal/Weak.hs
- libraries/ghc-internal/src/GHC/Internal/Weak/Finalize.hs
- libraries/ghc-internal/src/GHC/Internal/Windows.hs
- libraries/ghc-internal/src/GHC/Internal/Word.hs
- libraries/ghc-internal/tools/ucd2haskell/exe/UCD2Haskell/ModuleGenerators.hs
- − libraries/ghci/GHCi/BinaryArray.hs
- + libraries/ghci/GHCi/Coverage.hs
- libraries/ghci/GHCi/CreateBCO.hs
- libraries/ghci/GHCi/Message.hs
- libraries/ghci/GHCi/ResolvedBCO.hs
- libraries/ghci/GHCi/Run.hs
- libraries/ghci/GHCi/Server.hs
- libraries/ghci/ghci.cabal.in
- − m4/fp_check_timer_create.m4
- rts/Apply.cmm
- rts/CloneStack.c
- rts/CloneStack.h
- rts/Continuation.c
- rts/ContinuationOps.cmm
- rts/Disassembler.c
- rts/HeapStackCheck.cmm
- rts/Hpc.c
- rts/IOManager.c
- rts/Interpreter.c
- rts/Messages.c
- rts/PrimOps.cmm
- rts/Printer.c
- rts/RaiseAsync.c
- rts/RtsFlags.c
- rts/RtsSymbols.c
- rts/STM.c
- rts/STM.h
- rts/Schedule.c
- rts/StgCRun.c
- rts/StgMiscClosures.cmm
- rts/Threads.c
- rts/Threads.h
- rts/Timer.c
- rts/configure.ac
- rts/eventlog/EventLog.c
- rts/include/rts/Bytecodes.h
- rts/include/rts/Constants.h
- rts/include/rts/PosixSource.h
- rts/include/rts/Timer.h
- rts/include/rts/storage/TSO.h
- rts/include/stg/MiscClosures.h
- rts/include/stg/Prim.h
- rts/include/stg/SMP.h
- rts/js/arith.js
- rts/posix/Signals.c
- rts/posix/Signals.h
- rts/posix/Ticker.c
- − rts/posix/ticker/Setitimer.c
- − rts/posix/ticker/TimerCreate.c
- rts/prim/vectorQuotRem.c
- rts/rts.cabal
- rts/win32/AsyncMIO.c
- rts/win32/AsyncMIO.h
- testsuite/driver/testlib.py
- testsuite/tests/ado/ado004.hs
- testsuite/tests/annotations/should_fail/annfail02.hs
- testsuite/tests/annotations/should_fail/annfail02.stderr
- testsuite/tests/array/should_run/arr020.hs
- + testsuite/tests/bytecode/T27001.hs
- + testsuite/tests/bytecode/T27001.stdout
- + testsuite/tests/bytecode/TLinkable/BCOTemplate.hs
- + testsuite/tests/bytecode/TLinkable/LinkableUsage01.stderr
- + testsuite/tests/bytecode/TLinkable/LinkableUsage02.stderr
- + testsuite/tests/bytecode/TLinkable/Makefile
- + testsuite/tests/bytecode/TLinkable/all.T
- + testsuite/tests/bytecode/TLinkable/genLinkables.sh
- + testsuite/tests/bytecode/TLinkable/linkable-space.hs
- + testsuite/tests/bytecode/TLinkable/linkable-space.stdout
- testsuite/tests/bytecode/all.T
- + testsuite/tests/bytecode/tuplestress/ByteCode.hs
- + testsuite/tests/bytecode/tuplestress/Common.hs-incl
- + testsuite/tests/bytecode/tuplestress/Obj.hs
- + testsuite/tests/bytecode/tuplestress/TupleStress.hs
- + testsuite/tests/bytecode/tuplestress/TupleStress.stdout
- + testsuite/tests/bytecode/tuplestress/all.T
- + testsuite/tests/codeGen/should_run/T21227.hs
- + testsuite/tests/codeGen/should_run/T21227.stdout
- + testsuite/tests/codeGen/should_run/T9811.hs
- + testsuite/tests/codeGen/should_run/T9811.stdout
- testsuite/tests/codeGen/should_run/Word2Float32.hs
- testsuite/tests/codeGen/should_run/Word2Float32.stdout
- testsuite/tests/codeGen/should_run/Word2Float64.hs
- testsuite/tests/codeGen/should_run/Word2Float64.stdout
- testsuite/tests/codeGen/should_run/all.T
- + testsuite/tests/concurrent/should_run/T26341.hs
- + testsuite/tests/concurrent/should_run/T26341.stdout
- + testsuite/tests/concurrent/should_run/T26341a.hs
- + testsuite/tests/concurrent/should_run/T26341a.stdout
- + testsuite/tests/concurrent/should_run/T26341b.hs
- + testsuite/tests/concurrent/should_run/T26341b.stdout
- testsuite/tests/concurrent/should_run/all.T
- testsuite/tests/core-to-stg/T19700.hs
- testsuite/tests/count-deps/CountDepsAst.stdout
- testsuite/tests/count-deps/CountDepsParser.stdout
- testsuite/tests/deSugar/should_fail/DsStrictFail.hs
- testsuite/tests/deriving/should_compile/T15798b.hs
- testsuite/tests/deriving/should_compile/T15798c.hs
- testsuite/tests/deriving/should_compile/T15798c.stderr
- testsuite/tests/deriving/should_compile/T24955a.hs
- testsuite/tests/deriving/should_compile/T24955a.stderr
- testsuite/tests/deriving/should_compile/T24955b.hs
- testsuite/tests/deriving/should_compile/T24955c.hs
- testsuite/tests/deriving/should_fail/T10598_fail4.hs
- testsuite/tests/deriving/should_fail/T10598_fail4.stderr
- testsuite/tests/deriving/should_fail/T10598_fail5.hs
- testsuite/tests/deriving/should_fail/T10598_fail5.stderr
- testsuite/tests/dmdanal/sigs/T22241.hs
- + testsuite/tests/driver/T13729/A/A.cabal
- + testsuite/tests/driver/T13729/A/Setup.hs
- + testsuite/tests/driver/T13729/A/TH.hs
- + testsuite/tests/driver/T13729/A/Types1.hs
- + testsuite/tests/driver/T13729/A/Types2.hs
- + testsuite/tests/driver/T13729/B/B.cabal
- + testsuite/tests/driver/T13729/B/Main.hs
- + testsuite/tests/driver/T13729/B/Setup.hs
- + testsuite/tests/driver/T13729/Makefile
- + testsuite/tests/driver/T13729/Setup.hs
- + testsuite/tests/driver/T13729/all.T
- + testsuite/tests/driver/T18177.hs
- testsuite/tests/driver/all.T
- testsuite/tests/driver/multipleHomeUnits/multipleHomeUnits_recomp_th.stdout
- + testsuite/tests/driver/recomp022/A1.hs
- + testsuite/tests/driver/recomp022/A2.hs
- + testsuite/tests/driver/recomp022/A3.hs
- + testsuite/tests/driver/recomp022/B.hs
- + testsuite/tests/driver/recomp022/C.hs
- + testsuite/tests/driver/recomp022/Makefile
- + testsuite/tests/driver/recomp022/all.T
- + testsuite/tests/driver/recomp022/recomp022a.stdout
- + testsuite/tests/driver/recomp022/recomp022b.stdout
- + testsuite/tests/ffi/should_compile/T26852.h
- + testsuite/tests/ffi/should_compile/T26852.hs
- + testsuite/tests/ffi/should_compile/T26852.stderr
- testsuite/tests/ffi/should_compile/all.T
- testsuite/tests/gadt/T20485.hs
- + testsuite/tests/ghc-api/T25121_status.hs
- + testsuite/tests/ghc-api/T25121_status.stdout
- + testsuite/tests/ghc-api/T26910.hs
- + testsuite/tests/ghc-api/T26910.stdout
- + testsuite/tests/ghc-api/T26910_Input.hs
- testsuite/tests/ghc-api/all.T
- testsuite/tests/ghc-api/fixed-nodes/FixedNodes.hs
- testsuite/tests/ghc-api/fixed-nodes/ModuleGraphInvariants.hs
- testsuite/tests/ghci.debugger/scripts/all.T
- testsuite/tests/ghci.debugger/scripts/break012.hs
- testsuite/tests/ghci.debugger/scripts/break012.stdout
- + testsuite/tests/ghci/custom-external-interpreter-commands/Main.hs
- + testsuite/tests/ghci/custom-external-interpreter-commands/all.T
- + testsuite/tests/ghci/custom-external-interpreter-commands/custom-external-interpreter-commands.stdout
- testsuite/tests/ghci/prog-mhu002/all.T
- testsuite/tests/ghci/prog-mhu005/Makefile
- testsuite/tests/ghci/prog-mhu005/all.T
- + testsuite/tests/ghci/prog-mhu005/prog-mhu005b.script
- + testsuite/tests/ghci/prog-mhu005/prog-mhu005b.stdout
- + testsuite/tests/ghci/prog-mhu005/prog-mhu005c.script
- + testsuite/tests/ghci/prog-mhu005/prog-mhu005c.stderr
- + testsuite/tests/ghci/prog-mhu005/prog-mhu005c.stdout
- + testsuite/tests/ghci/prog-mhu005/prog-mhu005d.script
- + testsuite/tests/ghci/prog-mhu005/prog-mhu005d.stderr
- + testsuite/tests/ghci/prog-mhu005/prog-mhu005d.stdout
- + testsuite/tests/ghci/prog-mhu005/prog-mhu005e.script
- + testsuite/tests/ghci/prog-mhu005/prog-mhu005e.stderr
- + testsuite/tests/ghci/prog-mhu005/prog-mhu005e.stdout
- + testsuite/tests/ghci/prog-mhu005/prog-mhu005f.script
- + testsuite/tests/ghci/prog-mhu005/prog-mhu005f.stderr
- + testsuite/tests/ghci/prog-mhu005/prog-mhu005f.stdout
- + testsuite/tests/ghci/prog-mhu005/prog-mhu005g.script
- + testsuite/tests/ghci/prog-mhu005/prog-mhu005g.stderr
- + testsuite/tests/ghci/prog-mhu005/prog-mhu005g.stdout
- testsuite/tests/ghci/prog022/Makefile
- testsuite/tests/ghci/prog022/all.T
- + testsuite/tests/ghci/prog022/ghci.prog022c.script
- + testsuite/tests/ghci/prog022/ghci.prog022c.stderr
- + testsuite/tests/ghci/prog022/ghci.prog022c.stdout
- + testsuite/tests/ghci/prog022/ghci.prog022d.script
- + testsuite/tests/ghci/prog022/ghci.prog022d.stderr
- + testsuite/tests/ghci/prog022/ghci.prog022d.stdout
- + testsuite/tests/ghci/prog022/ghci.prog022e.script
- + testsuite/tests/ghci/prog022/ghci.prog022e.stderr
- + testsuite/tests/ghci/prog022/ghci.prog022e.stdout
- + testsuite/tests/ghci/prog022/ghci.prog022f.script
- + testsuite/tests/ghci/prog022/ghci.prog022f.stderr
- + testsuite/tests/ghci/prog022/ghci.prog022f.stdout
- testsuite/tests/ghci/scripts/ListTuplePunsPpr.stdout
- testsuite/tests/ghci/scripts/Makefile
- testsuite/tests/ghci/scripts/T10963.stderr
- testsuite/tests/ghci/scripts/ghci064.stdout
- testsuite/tests/ghci/should_run/BinaryArray.hs
- testsuite/tests/ghci/should_run/all.T
- + testsuite/tests/hpc/ghc_ghci/BytecodeMain.hs
- testsuite/tests/hpc/ghc_ghci/Makefile
- + testsuite/tests/hpc/ghc_ghci/hpc_ghc_ghci_bytecode.stdout
- testsuite/tests/hpc/ghc_ghci/test.T
- testsuite/tests/indexed-types/should_compile/T15322.hs
- testsuite/tests/indexed-types/should_compile/T15322.stderr
- testsuite/tests/interface-stability/base-exports.stdout
- testsuite/tests/interface-stability/base-exports.stdout-javascript-unknown-ghcjs
- testsuite/tests/interface-stability/base-exports.stdout-mingw32
- testsuite/tests/interface-stability/base-exports.stdout-ws-32
- testsuite/tests/interface-stability/ghc-experimental-exports.stdout
- testsuite/tests/interface-stability/ghc-experimental-exports.stdout-mingw32
- testsuite/tests/interface-stability/template-haskell-exports.stdout
- + testsuite/tests/javascript/js-c-sources/T27033.hs
- + testsuite/tests/javascript/js-c-sources/T27033.stdout
- + testsuite/tests/javascript/js-c-sources/T27033_c.c
- + testsuite/tests/javascript/js-c-sources/T27033_js.js
- testsuite/tests/javascript/js-c-sources/all.T
- + testsuite/tests/lib/stm/T26028.hs
- + testsuite/tests/lib/stm/T26028.stdout
- + testsuite/tests/lib/stm/T26291a.hs
- + testsuite/tests/lib/stm/T26291a.stdout
- + testsuite/tests/lib/stm/T26291b.hs
- + testsuite/tests/lib/stm/T26291b.stdout
- + testsuite/tests/lib/stm/all.T
- testsuite/tests/linear/should_fail/T18888.hs
- testsuite/tests/module/T20007.hs
- testsuite/tests/module/T20007.stderr
- testsuite/tests/module/mod90.hs
- testsuite/tests/module/mod90.stderr
- testsuite/tests/numeric/should_run/T7014.hs
- + testsuite/tests/overloadedrecflds/should_compile/T26686.hs
- + testsuite/tests/overloadedrecflds/should_compile/T26686.stderr
- testsuite/tests/overloadedrecflds/should_compile/all.T
- testsuite/tests/overloadedrecflds/should_fail/NoFieldSelectorsFail.hs
- testsuite/tests/overloadedrecflds/should_fail/T18999_NoDisambiguateRecordFields.hs
- testsuite/tests/overloadedrecflds/should_fail/all.T
- testsuite/tests/parser/should_compile/DumpParsedAst.stderr
- testsuite/tests/parser/should_compile/DumpRenamedAst.stderr
- + testsuite/tests/parser/should_compile/T12002.hs
- + testsuite/tests/parser/should_compile/T12002.stderr
- testsuite/tests/parser/should_compile/all.T
- testsuite/tests/parser/should_fail/ParserNoLambdaCase.hs
- testsuite/tests/parser/should_fail/ParserNoLambdaCase.stderr
- testsuite/tests/parser/should_fail/T16270h.hs
- testsuite/tests/parser/should_fail/T16270h.stderr
- testsuite/tests/parser/should_fail/T17865.stderr
- testsuite/tests/parser/should_fail/readFail001.hs
- testsuite/tests/parser/should_fail/readFail001.stderr
- testsuite/tests/partial-sigs/should_compile/SomethingShowable.hs
- + testsuite/tests/partial-sigs/should_compile/T11107.hs
- + testsuite/tests/partial-sigs/should_compile/T11107.stderr
- testsuite/tests/partial-sigs/should_compile/all.T
- + testsuite/tests/perf/compiler/T13820.hs
- + testsuite/tests/perf/compiler/T13960.hs
- testsuite/tests/perf/compiler/all.T
- testsuite/tests/perf/size/all.T
- testsuite/tests/plugins/late-plugin/LatePlugin.hs
- testsuite/tests/polykinds/T7151.hs
- testsuite/tests/polykinds/T7151.stderr
- testsuite/tests/polykinds/T7433.hs
- testsuite/tests/polykinds/T7433.stderr
- testsuite/tests/profiling/should_run/callstack001.stdout
- testsuite/tests/profiling/should_run/callstack002.stderr
- testsuite/tests/profiling/should_run/callstack002.stdout
- testsuite/tests/programs/andy_cherry/test.T
- + testsuite/tests/rebindable/T10381.hs
- testsuite/tests/rebindable/all.T
- testsuite/tests/rename/should_fail/T10668.hs
- testsuite/tests/rename/should_fail/T10668.stderr
- testsuite/tests/rename/should_fail/T12681.hs
- testsuite/tests/rename/should_fail/T12681.stderr
- testsuite/tests/rename/should_fail/T13568.hs
- testsuite/tests/rename/should_fail/T13568.stderr
- testsuite/tests/rename/should_fail/T13644.hs
- testsuite/tests/rename/should_fail/T13644.stderr
- testsuite/tests/rename/should_fail/T13847.hs
- testsuite/tests/rename/should_fail/T13847.stderr
- testsuite/tests/rename/should_fail/T14032c.hs
- testsuite/tests/rename/should_fail/T19843l.hs
- testsuite/tests/rename/should_fail/T19843l.stderr
- testsuite/tests/rename/should_fail/T25901_imp_hq_fail_5.stderr
- testsuite/tests/rename/should_fail/T25901_imp_sq_fail_2.stderr
- testsuite/tests/rename/should_fail/T5385.hs
- testsuite/tests/rename/should_fail/T5385.stderr
- testsuite/tests/roles/should_fail/Roles5.hs
- testsuite/tests/roles/should_fail/Roles5.stderr
- testsuite/tests/rts/all.T
- + testsuite/tests/rts/cloneThreadStackMigrating.hs
- + testsuite/tests/rts/resizeMutableByteArrayInPlace.hs
- testsuite/tests/showIface/DocsInHiFile.hs
- testsuite/tests/showIface/DocsInHiFile1.stdout
- testsuite/tests/showIface/DocsInHiFileTH.hs
- testsuite/tests/showIface/DocsInHiFileTH.stdout
- testsuite/tests/showIface/DocsInHiFileTHExternal.hs
- testsuite/tests/showIface/HaddockIssue849.hs
- testsuite/tests/showIface/HaddockIssue849.stdout
- testsuite/tests/showIface/HaddockOpts.hs
- testsuite/tests/showIface/HaddockOpts.stdout
- testsuite/tests/showIface/HaddockSpanIssueT24378.hs
- testsuite/tests/showIface/HaddockSpanIssueT24378.stdout
- testsuite/tests/showIface/MagicHashInHaddocks.hs
- testsuite/tests/showIface/MagicHashInHaddocks.stdout
- testsuite/tests/showIface/Makefile
- testsuite/tests/showIface/NoExportList.hs
- testsuite/tests/showIface/NoExportList.stdout
- testsuite/tests/showIface/PragmaDocs.stdout
- testsuite/tests/showIface/ReExports.stdout
- + testsuite/tests/simd/should_run/FloatConstant.hs
- + testsuite/tests/simd/should_run/FloatConstant.stdout
- + testsuite/tests/simd/should_run/IntConstant.hs
- + testsuite/tests/simd/should_run/IntConstant.stdout
- + testsuite/tests/simd/should_run/StackAlignment32.hs
- + testsuite/tests/simd/should_run/StackAlignment32.stdout
- + testsuite/tests/simd/should_run/StackAlignment32_main.c
- + testsuite/tests/simd/should_run/StackAlignment64.hs
- + testsuite/tests/simd/should_run/StackAlignment64.stdout
- + testsuite/tests/simd/should_run/StackAlignment64_main.c
- testsuite/tests/simd/should_run/all.T
- testsuite/tests/simd/should_run/int16x8_shuffle.hs
- testsuite/tests/simd/should_run/int16x8_shuffle.stdout
- testsuite/tests/simd/should_run/int16x8_shuffle_baseline.hs
- testsuite/tests/simd/should_run/int16x8_shuffle_baseline.stdout
- testsuite/tests/simd/should_run/int8x16_shuffle.hs
- testsuite/tests/simd/should_run/int8x16_shuffle.stdout
- testsuite/tests/simd/should_run/int8x16_shuffle_baseline.hs
- testsuite/tests/simd/should_run/int8x16_shuffle_baseline.stdout
- testsuite/tests/simd/should_run/simd013C.c
- testsuite/tests/simplCore/T9646/test.T
- + testsuite/tests/simplCore/should_compile/T18032.hs
- + testsuite/tests/simplCore/should_compile/T18032.stderr
- + testsuite/tests/simplCore/should_compile/T19166.hs
- + testsuite/tests/simplCore/should_compile/T19166.stderr
- testsuite/tests/simplCore/should_compile/T21960.hs
- + testsuite/tests/simplCore/should_compile/T25718.hs
- + testsuite/tests/simplCore/should_compile/T25718.stderr
- + testsuite/tests/simplCore/should_compile/T25718a.hs
- + testsuite/tests/simplCore/should_compile/T25718a.stderr
- + testsuite/tests/simplCore/should_compile/T25718b.hs
- + testsuite/tests/simplCore/should_compile/T25718b.stderr
- + testsuite/tests/simplCore/should_compile/T25718c.hs
- + testsuite/tests/simplCore/should_compile/T25718c.stderr-ws-32
- + testsuite/tests/simplCore/should_compile/T25718c.stderr-ws-64
- testsuite/tests/simplCore/should_compile/T26709.stderr
- testsuite/tests/simplCore/should_compile/all.T
- + testsuite/tests/simplCore/should_run/T27071.hs
- + testsuite/tests/simplCore/should_run/T27071.stdout
- testsuite/tests/simplCore/should_run/all.T
- testsuite/tests/simplStg/should_run/all.T
- + testsuite/tests/simplStg/should_run/unpack_enum.hs
- + testsuite/tests/simplStg/should_run/unpack_enum.stdout
- testsuite/tests/th/TH_Promoted1Tuple.hs
- testsuite/tests/th/TH_Roles1.hs
- + testsuite/tests/typecheck/T13180/T13180.hs
- + testsuite/tests/typecheck/T13180/T13180.hs-boot
- + testsuite/tests/typecheck/T13180/T13180.stderr
- + testsuite/tests/typecheck/T13180/T13180A.hs
- + testsuite/tests/typecheck/T13180/all.T
- testsuite/tests/typecheck/should_compile/MutRec.hs
- testsuite/tests/typecheck/should_compile/T10770a.hs
- + testsuite/tests/typecheck/should_compile/T11141.hs
- + testsuite/tests/typecheck/should_compile/T11141.stderr
- testsuite/tests/typecheck/should_compile/T11339.hs
- testsuite/tests/typecheck/should_compile/T11397.hs
- + testsuite/tests/typecheck/should_compile/T11505Bar.hs
- + testsuite/tests/typecheck/should_compile/T11505Foo.hs
- + testsuite/tests/typecheck/should_compile/T11505Foo.hs-boot
- + testsuite/tests/typecheck/should_compile/T12046.hs
- testsuite/tests/typecheck/should_compile/T13526.hs
- testsuite/tests/typecheck/should_compile/T18467.hs
- testsuite/tests/typecheck/should_compile/T18467.stderr
- testsuite/tests/typecheck/should_compile/T26225.hs
- testsuite/tests/typecheck/should_compile/all.T
- testsuite/tests/typecheck/should_compile/tc081.hs
- testsuite/tests/typecheck/should_compile/tc141.hs
- testsuite/tests/typecheck/should_fail/T23427.hs
- + testsuite/tests/typecheck/should_fail/T26823.hs
- + testsuite/tests/typecheck/should_fail/T26823.stderr
- testsuite/tests/typecheck/should_fail/T6078.hs
- testsuite/tests/typecheck/should_fail/T7453.hs
- testsuite/tests/typecheck/should_fail/T7453.stderr
- testsuite/tests/typecheck/should_fail/T8570.hs
- testsuite/tests/typecheck/should_fail/T8570.stderr
- testsuite/tests/typecheck/should_fail/all.T
- testsuite/tests/typecheck/should_fail/tcfail083.hs
- testsuite/tests/typecheck/should_fail/tcfail083.stderr
- testsuite/tests/typecheck/should_fail/tcfail084.hs
- testsuite/tests/typecheck/should_fail/tcfail084.stderr
- testsuite/tests/typecheck/should_fail/tcfail094.hs
- testsuite/tests/typecheck/should_fail/tcfail094.stderr
- testsuite/tests/typecheck/should_run/T1735.hs
- testsuite/tests/typecheck/should_run/T1735_Help/Basics.hs
- testsuite/tests/typecheck/should_run/T3731.hs
- + testsuite/tests/vdq-rta/should_compile/T26967.hs
- + testsuite/tests/vdq-rta/should_compile/T26967.stderr
- + testsuite/tests/vdq-rta/should_compile/T26967_tyop.hs
- + testsuite/tests/vdq-rta/should_compile/T26967_tyop.stderr
- testsuite/tests/vdq-rta/should_compile/all.T
- testsuite/tests/vdq-rta/should_fail/T24159_type_syntax_th_fail.script
- testsuite/tests/warnings/should_fail/CaretDiagnostics1.hs
- testsuite/tests/warnings/should_fail/CaretDiagnostics1.stderr
- testsuite/tests/warnings/should_fail/T24396c.hs
- testsuite/tests/warnings/should_fail/T24396c.stderr
- utils/check-exact/ExactPrint.hs
- utils/deriveConstants/Main.hs
- utils/haddock/haddock-api/src/Haddock/Backends/Hoogle.hs
- utils/haddock/haddock-api/src/Haddock/Backends/LaTeX.hs
- utils/haddock/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs
- utils/haddock/haddock-api/src/Haddock/Convert.hs
- utils/haddock/haddock-api/src/Haddock/GhcUtils.hs
- utils/haddock/haddock-api/src/Haddock/Interface/Rename.hs
- utils/haddock/haddock-api/src/Haddock/Interface/RenameType.hs
The diff was not included because it is too large.
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e9b23c146173db723c8f0db5f96a8c…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e9b23c146173db723c8f0db5f96a8c…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/spj-apporv-Oct24] 9 commits: Bump default language edition to GHC2024
by Simon Peyton Jones (＠simonpj) 02 Apr '26
by Simon Peyton Jones (＠simonpj) 02 Apr '26
02 Apr '26
Simon Peyton Jones pushed to branch wip/spj-apporv-Oct24 at Glasgow Haskell Compiler / GHC
Commits:
7fbb4fcb by Rodrigo Mesquita at 2026-04-01T12:16:33+00:00
Bump default language edition to GHC2024
As per the accepted ghc-proposal#632
Fixes #26039
- - - - -
5ae43275 by Peng Fan at 2026-04-01T19:01:06-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
- - - - -
8f95534a by Duncan Coutts at 2026-04-01T19:01:52-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.
- - - - -
51b32b0d by Duncan Coutts at 2026-04-01T19:01:52-04:00
Tidy up some timer/ticker comments elsewhere
- - - - -
7562bcd7 by Duncan Coutts at 2026-04-01T19:01:52-04:00
Remove now-unused install_vtalrm_handler
Support function used by both of the signal-based ticker
implementations.
- - - - -
6da127c7 by Duncan Coutts at 2026-04-01T19:01:52-04:00
No longer probe for timer_create in rts/configure
It was only used by the TimerCreate.c ticker impl.
- - - - -
3fd490fa by Duncan Coutts at 2026-04-01T19:01:53-04:00
Note that rtsTimerSignal is deprecated.
- - - - -
63099b0f by Simon Jakobi at 2026-04-01T19:02:39-04:00
Add perf test for #13960
Closes #13960.
- - - - -
58009c14 by Apoorv Ingle at 2026-04-02T09:51:24+01:00
Streamline expansions using HsExpansion (#25001)
Notes added [Error Context Stack] [Typechecking by expansion: overview]
Notes updated Note [Expanding HsDo with XXExprGhcRn] [tcApp: typechecking applications]
-------------------------
Metric Decrease:
T9020
-------------------------
There are 2 key changes:
1. `HsExpand` datatype mediates between expansions
2. Replace `ErrCtxtM` to a simpler `HsCtxt` that does not depend on a `TidyEnv`
This has some consequences detailed below:
1. `HsExpand` datatype mediates between expansions
* Simplifies the implementations of `tcExpr` to work on `XExpr`
* Removes `VACtxt` (and its associated `VAExpansion` and `VACall`) datatype, it is subsumed by simply a `SrcSpan`.
* Removes the function `addHeadCtxt` as it is now mearly setting a location
* The function `tcValArgs` does its own argument number management
* move `splitHsTypes` out of `tcApp`
* Removes special case of tcBody from `tcLambdaMatches`
* Removes special case of `dsExpr` for `ExpandedThingTc`
* Renames `tcMonoExpr` -> `tcMonoLExpr`, `tcMonoExprNC` -> `tcMonoLExpr`
* Renames `EValArg`, `EValArgQL` fields: `ea_ctxt` -> `ea_loc_span` and `eaql_ctx` -> `eaql_loc_span`
* Remove `PopErrCtxt` from `XXExprGhcRn`
* `fun_orig` in tcInstFun depends on the SrcSpan of the head of the application chain (similar to addArgCtxt)
- it references the application chain head if it is user located, or
uses the error context stack as a fallback if it's a generated
location
* Make a new variant `GeneratedSrcSpan` in `SrcSpan` for HIEAst Nodes
- Expressions wrapped around `GeneratedSrcSpan` are ignored and never added to the error context stack
- In Explicit list expansion `fromListN` is wrapped with a `GeneratedSrcSpan` with `GeneratedSrcSpanDetails` field to store the original srcspan
2. Replace `ErrCtxtM` to a simpler `HsCtxt` that does not depend on a `TidyEnv`
* Merge `HsThingRn` to `HsCtxt`
* Landmark Error messages are now just computed on the fly
* Make HsExpandedRn and HsExpandedTc payload a located HsExpr GhcRn
* `HsCtxt` are tidied and zonked at the end right before printing
Co-authored-by: simonpj <simon.peytonjones(a)gmail.com>
- - - - -
251 changed files:
- .gitlab/ci.sh
- compiler/GHC.hs
- compiler/GHC/CmmToAsm/LA64/CodeGen.hs
- compiler/GHC/CmmToAsm/LA64/Instr.hs
- compiler/GHC/CmmToAsm/LA64/Ppr.hs
- compiler/GHC/Driver/Flags.hs
- compiler/GHC/Hs/DocString.hs
- compiler/GHC/Hs/Expr.hs
- compiler/GHC/Hs/Expr.hs-boot
- compiler/GHC/Hs/Instances.hs
- compiler/GHC/Hs/Syn/Type.hs
- compiler/GHC/HsToCore/Expr.hs
- compiler/GHC/HsToCore/Match.hs
- compiler/GHC/HsToCore/Monad.hs
- compiler/GHC/HsToCore/Pmc.hs
- compiler/GHC/HsToCore/Quote.hs
- compiler/GHC/HsToCore/Ticks.hs
- compiler/GHC/Iface/Ext/Ast.hs
- compiler/GHC/Iface/Ext/Utils.hs
- compiler/GHC/Parser/HaddockLex.x
- compiler/GHC/Rename/Expr.hs
- compiler/GHC/Rename/Names.hs
- compiler/GHC/Rename/Utils.hs
- compiler/GHC/Runtime/Debugger/Breakpoints.hs
- compiler/GHC/Tc/Deriv.hs
- compiler/GHC/Tc/Deriv/Infer.hs
- compiler/GHC/Tc/Deriv/Utils.hs
- compiler/GHC/Tc/Errors.hs
- compiler/GHC/Tc/Errors/Ppr.hs
- compiler/GHC/Tc/Errors/Types.hs
- compiler/GHC/Tc/Gen/App.hs
- compiler/GHC/Tc/Gen/Bind.hs
- compiler/GHC/Tc/Gen/Do.hs
- + compiler/GHC/Tc/Gen/Expand.hs
- compiler/GHC/Tc/Gen/Export.hs
- compiler/GHC/Tc/Gen/Expr.hs
- compiler/GHC/Tc/Gen/Expr.hs-boot
- compiler/GHC/Tc/Gen/Head.hs
- compiler/GHC/Tc/Gen/HsType.hs
- compiler/GHC/Tc/Gen/Match.hs
- compiler/GHC/Tc/Gen/Match.hs-boot
- compiler/GHC/Tc/Gen/Pat.hs
- compiler/GHC/Tc/Gen/Sig.hs
- compiler/GHC/Tc/Gen/Splice.hs
- compiler/GHC/Tc/Instance/Class.hs
- compiler/GHC/Tc/Module.hs
- compiler/GHC/Tc/Solver/Solve.hs
- compiler/GHC/Tc/TyCl.hs
- compiler/GHC/Tc/TyCl/Class.hs
- compiler/GHC/Tc/TyCl/Instance.hs
- compiler/GHC/Tc/TyCl/PatSyn.hs
- compiler/GHC/Tc/Types.hs
- compiler/GHC/Tc/Types/BasicTypes.hs
- compiler/GHC/Tc/Types/Constraint.hs
- compiler/GHC/Tc/Types/CtLoc.hs
- compiler/GHC/Tc/Types/ErrCtxt.hs
- compiler/GHC/Tc/Types/LclEnv.hs
- compiler/GHC/Tc/Types/Origin.hs
- compiler/GHC/Tc/Types/Origin.hs-boot
- compiler/GHC/Tc/Utils/Instantiate.hs
- compiler/GHC/Tc/Utils/Monad.hs
- compiler/GHC/Tc/Utils/TcMType.hs
- compiler/GHC/Tc/Utils/TcType.hs-boot
- compiler/GHC/Tc/Utils/Unify.hs
- compiler/GHC/Tc/Validity.hs
- compiler/GHC/Tc/Zonk/TcType.hs
- compiler/GHC/Tc/Zonk/Type.hs
- compiler/GHC/Types/Error.hs
- + compiler/GHC/Types/Error.hs-boot
- compiler/GHC/Types/Hint/Ppr.hs
- compiler/GHC/Types/Name/Reader.hs
- compiler/GHC/Types/SrcLoc.hs
- + compiler/GHC/Unit/State.hs-boot
- compiler/GHC/Utils/Binary.hs
- compiler/GHC/Utils/Logger.hs
- compiler/ghc.cabal.in
- docs/users_guide/exts/control.rst
- ghc/GHCi/UI.hs
- ghc/GHCi/UI/Info.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/ado/ado004.hs
- testsuite/tests/annotations/should_fail/annfail02.hs
- testsuite/tests/annotations/should_fail/annfail02.stderr
- testsuite/tests/array/should_run/arr020.hs
- testsuite/tests/core-to-stg/T19700.hs
- testsuite/tests/count-deps/CountDepsAst.stdout
- testsuite/tests/count-deps/CountDepsParser.stdout
- testsuite/tests/deSugar/should_fail/DsStrictFail.hs
- testsuite/tests/deriving/should_compile/T15798b.hs
- testsuite/tests/deriving/should_compile/T15798c.hs
- testsuite/tests/deriving/should_compile/T15798c.stderr
- testsuite/tests/deriving/should_compile/T24955a.hs
- testsuite/tests/deriving/should_compile/T24955a.stderr
- testsuite/tests/deriving/should_compile/T24955b.hs
- testsuite/tests/deriving/should_compile/T24955c.hs
- testsuite/tests/deriving/should_fail/T10598_fail4.hs
- testsuite/tests/deriving/should_fail/T10598_fail4.stderr
- testsuite/tests/deriving/should_fail/T10598_fail5.hs
- testsuite/tests/deriving/should_fail/T10598_fail5.stderr
- testsuite/tests/dmdanal/sigs/T22241.hs
- testsuite/tests/gadt/T20485.hs
- testsuite/tests/ghci.debugger/scripts/all.T
- testsuite/tests/ghci.debugger/scripts/break012.hs
- testsuite/tests/ghci.debugger/scripts/break012.stdout
- testsuite/tests/ghci/prog-mhu001/prog-mhu001c.stdout
- testsuite/tests/ghci/prog-mhu002/all.T
- testsuite/tests/ghci/scripts/Makefile
- testsuite/tests/ghci/should_run/all.T
- testsuite/tests/indexed-types/should_compile/T15322.hs
- testsuite/tests/indexed-types/should_compile/T15322.stderr
- testsuite/tests/indexed-types/should_fail/T2693.stderr
- testsuite/tests/indexed-types/should_fail/T5439.stderr
- testsuite/tests/linear/should_fail/T18888.hs
- testsuite/tests/module/T20007.hs
- testsuite/tests/module/T20007.stderr
- testsuite/tests/module/mod90.hs
- testsuite/tests/module/mod90.stderr
- testsuite/tests/monadfail/MonadFailErrors.stderr
- testsuite/tests/overloadedrecflds/should_fail/NoFieldSelectorsFail.hs
- testsuite/tests/overloadedrecflds/should_fail/T18999_NoDisambiguateRecordFields.hs
- testsuite/tests/overloadedrecflds/should_fail/T26480b.stderr
- testsuite/tests/overloadedrecflds/should_fail/all.T
- testsuite/tests/parser/should_fail/ParserNoLambdaCase.hs
- testsuite/tests/parser/should_fail/ParserNoLambdaCase.stderr
- testsuite/tests/parser/should_fail/RecordDotSyntaxFail10.stderr
- testsuite/tests/parser/should_fail/RecordDotSyntaxFail11.stderr
- testsuite/tests/parser/should_fail/RecordDotSyntaxFail9.stderr
- testsuite/tests/parser/should_fail/T16270h.hs
- testsuite/tests/parser/should_fail/T16270h.stderr
- testsuite/tests/parser/should_fail/readFail001.hs
- testsuite/tests/parser/should_fail/readFail001.stderr
- testsuite/tests/partial-sigs/should_compile/SomethingShowable.hs
- testsuite/tests/partial-sigs/should_compile/SplicesUsed.stderr
- + testsuite/tests/perf/compiler/T13960.hs
- testsuite/tests/perf/compiler/all.T
- testsuite/tests/plugins/late-plugin/LatePlugin.hs
- testsuite/tests/plugins/test-defaulting-plugin.stderr
- testsuite/tests/polykinds/T7151.hs
- testsuite/tests/polykinds/T7151.stderr
- testsuite/tests/polykinds/T7433.hs
- testsuite/tests/polykinds/T7433.stderr
- testsuite/tests/printer/T17697.stderr
- testsuite/tests/profiling/should_run/callstack001.stdout
- testsuite/tests/programs/andy_cherry/test.T
- testsuite/tests/rebindable/rebindable6.stderr
- testsuite/tests/rename/should_fail/T10668.hs
- testsuite/tests/rename/should_fail/T10668.stderr
- testsuite/tests/rename/should_fail/T12681.hs
- testsuite/tests/rename/should_fail/T12681.stderr
- testsuite/tests/rename/should_fail/T13568.hs
- testsuite/tests/rename/should_fail/T13568.stderr
- testsuite/tests/rename/should_fail/T13644.hs
- testsuite/tests/rename/should_fail/T13644.stderr
- testsuite/tests/rename/should_fail/T13847.hs
- testsuite/tests/rename/should_fail/T13847.stderr
- testsuite/tests/rename/should_fail/T14032c.hs
- testsuite/tests/rename/should_fail/T19843l.hs
- testsuite/tests/rename/should_fail/T19843l.stderr
- testsuite/tests/rename/should_fail/T25901_imp_hq_fail_5.stderr
- testsuite/tests/rename/should_fail/T25901_imp_sq_fail_2.stderr
- testsuite/tests/rename/should_fail/T5385.hs
- testsuite/tests/rename/should_fail/T5385.stderr
- testsuite/tests/rep-poly/RepPolyRecordUpdate.stderr
- testsuite/tests/roles/should_fail/Roles5.hs
- testsuite/tests/roles/should_fail/Roles5.stderr
- testsuite/tests/showIface/DocsInHiFile.hs
- testsuite/tests/showIface/DocsInHiFile1.stdout
- testsuite/tests/showIface/DocsInHiFileTH.hs
- testsuite/tests/showIface/DocsInHiFileTH.stdout
- testsuite/tests/showIface/DocsInHiFileTHExternal.hs
- testsuite/tests/showIface/HaddockIssue849.hs
- testsuite/tests/showIface/HaddockIssue849.stdout
- testsuite/tests/showIface/HaddockOpts.hs
- testsuite/tests/showIface/HaddockOpts.stdout
- testsuite/tests/showIface/HaddockSpanIssueT24378.hs
- testsuite/tests/showIface/HaddockSpanIssueT24378.stdout
- testsuite/tests/showIface/MagicHashInHaddocks.hs
- testsuite/tests/showIface/MagicHashInHaddocks.stdout
- testsuite/tests/showIface/Makefile
- testsuite/tests/showIface/NoExportList.hs
- testsuite/tests/showIface/NoExportList.stdout
- testsuite/tests/showIface/PragmaDocs.stdout
- testsuite/tests/showIface/ReExports.stdout
- testsuite/tests/simplCore/T9646/test.T
- testsuite/tests/simplCore/should_compile/T21960.hs
- testsuite/tests/simplCore/should_compile/T26709.stderr
- testsuite/tests/th/TH_Promoted1Tuple.hs
- testsuite/tests/th/TH_Roles1.hs
- + testsuite/tests/typecheck/should_compile/ExpansionQLIm.hs
- testsuite/tests/typecheck/should_compile/MutRec.hs
- testsuite/tests/typecheck/should_compile/T10770a.hs
- testsuite/tests/typecheck/should_compile/T11339.hs
- testsuite/tests/typecheck/should_compile/T11397.hs
- testsuite/tests/typecheck/should_compile/T13526.hs
- testsuite/tests/typecheck/should_compile/T14590.stderr
- testsuite/tests/typecheck/should_compile/T18467.hs
- testsuite/tests/typecheck/should_compile/T18467.stderr
- testsuite/tests/typecheck/should_compile/all.T
- testsuite/tests/typecheck/should_compile/tc081.hs
- testsuite/tests/typecheck/should_compile/tc141.hs
- testsuite/tests/typecheck/should_compile/valid_hole_fits.stderr
- testsuite/tests/typecheck/should_fail/DoExpansion1.stderr
- testsuite/tests/typecheck/should_fail/DoExpansion2.stderr
- testsuite/tests/typecheck/should_fail/T10971d.stderr
- testsuite/tests/typecheck/should_fail/T13311.stderr
- testsuite/tests/typecheck/should_fail/T23427.hs
- testsuite/tests/typecheck/should_fail/T3323.stderr
- testsuite/tests/typecheck/should_fail/T3613.stderr
- testsuite/tests/typecheck/should_fail/T6069.stderr
- testsuite/tests/typecheck/should_fail/T6078.hs
- testsuite/tests/typecheck/should_fail/T7453.hs
- testsuite/tests/typecheck/should_fail/T7453.stderr
- testsuite/tests/typecheck/should_fail/T7851.stderr
- testsuite/tests/typecheck/should_fail/T7857.stderr
- testsuite/tests/typecheck/should_fail/T8570.hs
- testsuite/tests/typecheck/should_fail/T8570.stderr
- testsuite/tests/typecheck/should_fail/T8603.stderr
- testsuite/tests/typecheck/should_fail/T9612.stderr
- testsuite/tests/typecheck/should_fail/tcfail083.hs
- testsuite/tests/typecheck/should_fail/tcfail083.stderr
- testsuite/tests/typecheck/should_fail/tcfail084.hs
- testsuite/tests/typecheck/should_fail/tcfail084.stderr
- testsuite/tests/typecheck/should_fail/tcfail094.hs
- testsuite/tests/typecheck/should_fail/tcfail094.stderr
- testsuite/tests/typecheck/should_fail/tcfail102.stderr
- testsuite/tests/typecheck/should_fail/tcfail128.stderr
- testsuite/tests/typecheck/should_fail/tcfail140.stderr
- testsuite/tests/typecheck/should_fail/tcfail181.stderr
- testsuite/tests/typecheck/should_run/T1735.hs
- testsuite/tests/typecheck/should_run/T1735_Help/Basics.hs
- testsuite/tests/typecheck/should_run/T3731.hs
- testsuite/tests/vdq-rta/should_fail/T24159_type_syntax_th_fail.script
- testsuite/tests/warnings/should_fail/CaretDiagnostics1.hs
- testsuite/tests/warnings/should_fail/CaretDiagnostics1.stderr
- testsuite/tests/warnings/should_fail/T24396c.hs
- testsuite/tests/warnings/should_fail/T24396c.stderr
- utils/check-exact/ExactPrint.hs
- utils/check-exact/Parsers.hs
- utils/check-exact/Transform.hs
- utils/check-exact/Utils.hs
- utils/haddock/haddock-api/src/Haddock/Backends/Hyperlinker/Parser.hs
- utils/haddock/haddock-api/src/Haddock/Backends/Xhtml/Utils.hs
The diff was not included because it is too large.
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/fbf988484484304b7a563b4454a388…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/fbf988484484304b7a563b4454a388…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/marge_bot_batch_merge_job] 9 commits: NCG/LA64: add cmpxchg and xchg primops
by Marge Bot (＠marge-bot) 02 Apr '26
by Marge Bot (＠marge-bot) 02 Apr '26
02 Apr '26
Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC
Commits:
5ae43275 by Peng Fan at 2026-04-01T19:01:06-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
- - - - -
8f95534a by Duncan Coutts at 2026-04-01T19:01:52-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.
- - - - -
51b32b0d by Duncan Coutts at 2026-04-01T19:01:52-04:00
Tidy up some timer/ticker comments elsewhere
- - - - -
7562bcd7 by Duncan Coutts at 2026-04-01T19:01:52-04:00
Remove now-unused install_vtalrm_handler
Support function used by both of the signal-based ticker
implementations.
- - - - -
6da127c7 by Duncan Coutts at 2026-04-01T19:01:52-04:00
No longer probe for timer_create in rts/configure
It was only used by the TimerCreate.c ticker impl.
- - - - -
3fd490fa by Duncan Coutts at 2026-04-01T19:01:53-04:00
Note that rtsTimerSignal is deprecated.
- - - - -
63099b0f by Simon Jakobi at 2026-04-01T19:02:39-04:00
Add perf test for #13960
Closes #13960.
- - - - -
f3082d66 by mangoiv at 2026-04-02T04:50:33-04:00
testsuite: filter stderr for static001 on darwin
This reactivates the test on x86_64 darwin as this should have been done
long ago and ignores warnings emitted by ranlib on newer version of the
darwin toolchain since they are benign. (no symbols for stub libraries)
Fixes #27116
- - - - -
9f075c7c by mangoiv at 2026-04-02T04:50:34-04:00
issue template: fix add bug label
- - - - -
18 changed files:
- .gitlab/issue_templates/default.md
- 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/driver/testlib.py
- testsuite/tests/driver/all.T
- + testsuite/tests/perf/compiler/T13960.hs
- testsuite/tests/perf/compiler/all.T
Changes:
=====================================
.gitlab/issue_templates/default.md
=====================================
@@ -20,5 +20,5 @@ Optional:
* System Architecture:
-/label ~bug
+/label ~"T::bug"
/label ~"needs triage"
=====================================
compiler/GHC/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 <stdio.h>
-#if defined(HAVE_STDLIB_H)
-#include <stdlib.h>
-#endif
-#include <time.h>
-#if defined(HAVE_SIGNAL_H)
-#include <signal.h>
-#endif
-#if defined(HAVE_UNISTD_H)
-#include <unistd.h>
-#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 <time.h>
-#if HAVE_SYS_TIME_H
-# include <sys/time.h>
-#endif
-
-#if defined(HAVE_SIGNAL_H)
-# include <signal.h>
-#endif
-
-#include <string.h>
-
-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 <signal.h>
-#endif
-
-#include <string.h>
-
-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/driver/testlib.py
=====================================
@@ -3043,6 +3043,12 @@ def normalise_errmsg(s: str) -> str:
# Old emcc warns when we export HEAP8 but new one requires it (see #26290)
s = s.replace('warning: invalid item in EXPORTED_RUNTIME_METHODS: HEAP8\nwarning: invalid item in EXPORTED_RUNTIME_METHODS: HEAPU8\nemcc: warning: warnings in JS library compilation [-Wjs-compiler]\n','')
+ # on newer versions of MacOS X, the shipped ranlib warns about object files with no symbols,
+ # however, these are completely benign stubs.
+ # See https://gitlab.haskell.org/ghc/ghc/-/issues/27116
+ if opsys('darwin'):
+ modify_lines(s, lambda l: re.sub(r'.*ranlib:.*has no symbols', '', l))
+
return s
# normalise a .prof file, so that we can reasonably compare it against
=====================================
testsuite/tests/driver/all.T
=====================================
@@ -120,9 +120,7 @@ if config.os == 'darwin':
else:
only_darwin = skip
-test('static001', [extra_files(['Static001.hs']),
- only_darwin,
- when(arch('x86_64'), expect_broken(8127))],
+test('static001', [extra_files(['Static001.hs']), only_darwin],
makefile_test, ['static001'])
test('dynHelloWorld',
=====================================
testsuite/tests/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/5c2c832e5f40352538992bd32746a5…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/5c2c832e5f40352538992bd32746a5…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/fendor/hpc-bc-support] Make HPC work with bytecode interpreter
by Hannes Siebenhandl (＠fendor) 02 Apr '26
by Hannes Siebenhandl (＠fendor) 02 Apr '26
02 Apr '26
Hannes Siebenhandl pushed to branch wip/fendor/hpc-bc-support at Glasgow Haskell Compiler / GHC
Commits:
e9b23c14 by fendor at 2026-04-02T10:45:08+02:00
Make HPC work with bytecode interpreter
Add support to generate .tix files from bytecode objects and the
bytecode interpreter.
Conceptually, we insert HPC ticks into the bytecode similar to how we insert
breakpoints.
HPC and breakpoints do not share the same tick array but we use a separate
tick-array for hpc/breakpoint ticks during bytecode generation.
We teach the bytecode interpreter to handle hpc ticks.
The implementation is quite trivial, simply increment the counter in the
global hpc_ticks array for the respective module.
This hpc_ticks array is generated as part of the `CStub`, so we can rely
on it existing.
A tricky bit is "registering" a bytecode object for HPC instrumentation.
In the compiled case, this is achieved via CStub and initializer/finalizers
`.init` sections which are called when the executable is run.
After the initializers have been invoked, which is before `hs_init_ghc`,
we then call `startup_hpc` in `hs_init_ghc` iff any modules were "registered"
for hpc instrumentation via `hs_hpc_module`.
Since bytecode objects are loaded after starting up GHCi, this workflow
doesn't work for supporting `hpc` and the `hpc` run-time is never
started, even if a module is added for instrumentation.
We fix this issue by employing the same technique as is for `SptEntry`s:
* We introduce a new field to `CompiledByteCode`, called `ByteCodeHpcInfo`
which contains enough information to call `hs_hpc_module`, allowing us to
register the module for `hpc` instrumentation`.
* After registering the module, we unconditionally call `startupHpc`, to make
sure the .tix file is written.
Calling `startupHpc` multiple times is safe.
Calling `hs_hpc_module` multiple times for the same module is also safe.
Evaluating a bytecode object instrumented with `-fhpc` without registering it
in the `hpc` run-time will simply not generate any `.tix` files for this
bytecode object.
Closes #27036
- - - - -
31 changed files:
- compiler/GHC/ByteCode/Asm.hs
- compiler/GHC/ByteCode/Instr.hs
- compiler/GHC/ByteCode/Serialize.hs
- compiler/GHC/ByteCode/Types.hs
- compiler/GHC/Driver/Backend.hs
- compiler/GHC/Driver/CodeOutput.hs
- compiler/GHC/Driver/Main.hs
- compiler/GHC/Driver/Session.hs
- compiler/GHC/HsToCore.hs
- compiler/GHC/HsToCore/Coverage.hs
- compiler/GHC/HsToCore/Ticks.hs
- compiler/GHC/Iface/Tidy.hs
- compiler/GHC/Linker/ByteCode.hs
- compiler/GHC/Linker/Loader.hs
- compiler/GHC/Linker/Types.hs
- compiler/GHC/Runtime/Interpreter.hs
- compiler/GHC/StgToByteCode.hs
- compiler/GHC/Types/HpcInfo.hs
- compiler/GHC/Unit/Module/ModGuts.hs
- + libraries/ghci/GHCi/Coverage.hs
- libraries/ghci/GHCi/Message.hs
- libraries/ghci/GHCi/Run.hs
- libraries/ghci/ghci.cabal.in
- rts/Disassembler.c
- rts/Hpc.c
- rts/Interpreter.c
- rts/include/rts/Bytecodes.h
- + testsuite/tests/hpc/ghc_ghci/BytecodeMain.hs
- testsuite/tests/hpc/ghc_ghci/Makefile
- + testsuite/tests/hpc/ghc_ghci/hpc_ghc_ghci_bytecode.stdout
- testsuite/tests/hpc/ghc_ghci/test.T
The diff was not included because it is too large.
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e9b23c146173db723c8f0db5f96a8cd…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e9b23c146173db723c8f0db5f96a8cd…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/fendor/hpc-bc-support] Make HPC work with bytecode interpreter
by Hannes Siebenhandl (＠fendor) 02 Apr '26
by Hannes Siebenhandl (＠fendor) 02 Apr '26
02 Apr '26
Hannes Siebenhandl pushed to branch wip/fendor/hpc-bc-support at Glasgow Haskell Compiler / GHC
Commits:
5c1b59b3 by Matthew Pickering at 2026-04-02T10:35:50+02:00
Make HPC work with bytecode interpreter
Add support to generate .tix files from bytecode objects and the
bytecode interpreter.
Conceptually, we insert HPC ticks into the bytecode similar to how we insert
breakpoints.
HPC and breakpoints do not share the same tick array but we use a separate
tick-array for hpc/breakpoint ticks during bytecode generation.
We teach the bytecode interpreter to handle hpc ticks.
The implementation is quite trivial, simply increment the counter in the
global hpc_ticks array for the respective module.
This hpc_ticks array is generated as part of the `CStub`, so we can rely
on it existing.
A tricky bit is "registering" a bytecode object for HPC instrumentation.
In the compiled case, this is achieved via CStub and initializer/finalizers
`.init` sections which are called when the executable is run.
After the initializers have been invoked, which is before `hs_init_ghc`,
we then call `startup_hpc` in `hs_init_ghc` iff any modules were "registered"
for hpc instrumentation via `hs_hpc_module`.
Since bytecode objects are loaded after starting up GHCi, this workflow
doesn't work for supporting `hpc` and the `hpc` run-time is never
started, even if a module is added for instrumentation.
We fix this issue by employing the same technique as is for `SptEntry`s:
* We introduce a new field to `CompiledByteCode`, called `ByteCodeHpcInfo`
which contains enough information to call `hs_hpc_module`, allowing us to
register the module for `hpc` instrumentation`.
* After registering the module, we unconditionally call `startupHpc`, to make
sure the .tix file is written.
Calling `startupHpc` multiple times is safe.
Calling `hs_hpc_module` multiple times for the same module is also safe.
Evaluating a bytecode object instrumented with `-fhpc` without registering it
in the `hpc` run-time will simply not generate any `.tix` files for this
bytecode object.
Closes #27036
- - - - -
31 changed files:
- compiler/GHC/ByteCode/Asm.hs
- compiler/GHC/ByteCode/Instr.hs
- compiler/GHC/ByteCode/Serialize.hs
- compiler/GHC/ByteCode/Types.hs
- compiler/GHC/Driver/Backend.hs
- compiler/GHC/Driver/CodeOutput.hs
- compiler/GHC/Driver/Main.hs
- compiler/GHC/Driver/Session.hs
- compiler/GHC/HsToCore.hs
- compiler/GHC/HsToCore/Coverage.hs
- compiler/GHC/HsToCore/Ticks.hs
- compiler/GHC/Iface/Tidy.hs
- compiler/GHC/Linker/ByteCode.hs
- compiler/GHC/Linker/Loader.hs
- compiler/GHC/Linker/Types.hs
- compiler/GHC/Runtime/Interpreter.hs
- compiler/GHC/StgToByteCode.hs
- compiler/GHC/Types/HpcInfo.hs
- compiler/GHC/Unit/Module/ModGuts.hs
- + libraries/ghci/GHCi/Coverage.hs
- libraries/ghci/GHCi/Message.hs
- libraries/ghci/GHCi/Run.hs
- libraries/ghci/ghci.cabal.in
- rts/Disassembler.c
- rts/Hpc.c
- rts/Interpreter.c
- rts/include/rts/Bytecodes.h
- + testsuite/tests/hpc/ghc_ghci/BytecodeMain.hs
- testsuite/tests/hpc/ghc_ghci/Makefile
- + testsuite/tests/hpc/ghc_ghci/hpc_ghc_ghci_bytecode.stdout
- testsuite/tests/hpc/ghc_ghci/test.T
The diff was not included because it is too large.
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/5c1b59b3767d8a1f6cdc7bc55aa01e7…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/5c1b59b3767d8a1f6cdc7bc55aa01e7…
You're receiving this email because of your account on gitlab.haskell.org.
1
0