[Git][ghc/ghc][master] driver: fix hpc undefined symbol issue in TH with -fprefer-byte-code
Marge Bot (@marge-bot)
gitlab at gitlab.haskell.org
Thu Nov 21 19:10:10 UTC 2024
Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC
Commits:
bcbcdaaf by Cheng Shao at 2024-11-21T14:09:28-05:00
driver: fix hpc undefined symbol issue in TH with -fprefer-byte-code
This commit fixes an undefined symbol error in RTS linker when
attempting to compile home modules with -fhpc and
-fbyte-code-and-object-code/-fprefer-byte-code, see #25510 for
detailed description and analysis of the bug.
Also adds T25510/T25510c regression tests to test make mode/oneshot
mode of the bug.
- - - - -
14 changed files:
- compiler/GHC/Driver/Config/StgToCmm.hs
- compiler/GHC/Driver/Hooks.hs
- compiler/GHC/Driver/Main.hs
- compiler/GHC/HsToCore/Coverage.hs
- compiler/GHC/Iface/Tidy.hs
- compiler/GHC/StgToCmm.hs
- compiler/GHC/StgToCmm/Config.hs
- compiler/GHC/StgToCmm/Hpc.hs
- compiler/GHC/Unit/Module/ModGuts.hs
- + testsuite/tests/bytecode/T25510/Makefile
- + testsuite/tests/bytecode/T25510/T25510A.hs
- + testsuite/tests/bytecode/T25510/T25510B.hs
- + testsuite/tests/bytecode/T25510/all.T
- testsuite/tests/wasm/should_run/control-flow/LoadCmmGroup.hs
Changes:
=====================================
compiler/GHC/Driver/Config/StgToCmm.hs
=====================================
@@ -38,7 +38,6 @@ initStgToCmmConfig dflags mod = StgToCmmConfig
-- flags
, stgToCmmLoopification = gopt Opt_Loopification dflags
, stgToCmmAlignCheck = gopt Opt_AlignmentSanitisation dflags
- , stgToCmmOptHpc = gopt Opt_Hpc dflags
, stgToCmmFastPAPCalls = gopt Opt_FastPAPCalls dflags
, stgToCmmSCCProfiling = sccProfilingEnabled dflags
, stgToCmmEagerBlackHole = gopt Opt_EagerBlackHoling dflags
=====================================
compiler/GHC/Driver/Hooks.hs
=====================================
@@ -48,7 +48,6 @@ import GHC.Types.Basic
import GHC.Types.CostCentre
import GHC.Types.IPE
import GHC.Types.Meta
-import GHC.Types.HpcInfo
import GHC.Unit.Module
import GHC.Unit.Module.ModSummary
@@ -149,7 +148,7 @@ data Hooks = Hooks
-> IO (Either Type (HValue, [Linkable], PkgsLoaded))))
, createIservProcessHook :: !(Maybe (CreateProcess -> IO ProcessHandle))
, stgToCmmHook :: !(Maybe (StgToCmmConfig -> InfoTableProvMap -> [TyCon] -> CollectedCCs
- -> [CgStgTopBinding] -> HpcInfo -> CgStream CmmGroup ModuleLFInfos))
+ -> [CgStgTopBinding] -> CgStream CmmGroup ModuleLFInfos))
, cmmToRawCmmHook :: !(forall a . Maybe (DynFlags -> Maybe Module -> CgStream CmmGroupSRTs a
-> IO (CgStream RawCmmGroup a)))
}
=====================================
compiler/GHC/Driver/Main.hs
=====================================
@@ -248,7 +248,6 @@ import GHC.Types.Name.Cache ( initNameCache )
import GHC.Types.Name.Reader
import GHC.Types.Name.Ppr
import GHC.Types.TyThing
-import GHC.Types.HpcInfo
import GHC.Types.Unique.Supply (uniqFromTag)
import GHC.Types.Unique.Set
@@ -1980,7 +1979,6 @@ hscGenHardCode hsc_env cgguts location output_filename = do
cg_foreign = foreign_stubs0,
cg_foreign_files = foreign_files,
cg_dep_pkgs = dependencies,
- cg_hpc_info = hpc_info,
cg_spt_entries = spt_entries,
cg_binds = late_binds,
cg_ccs = late_local_ccs
@@ -2084,7 +2082,7 @@ hscGenHardCode hsc_env cgguts location output_filename = do
cmms <- {-# SCC "StgToCmm" #-}
doCodeGen hsc_env this_mod denv data_tycons
cost_centre_info
- stg_binds hpc_info
+ stg_binds
------------------ Code output -----------------------
rawcmms0 <- {-# SCC "cmmToRawCmm" #-}
@@ -2291,13 +2289,12 @@ This reduces residency towards the end of the CodeGen phase significantly
doCodeGen :: HscEnv -> Module -> InfoTableProvMap -> [TyCon]
-> CollectedCCs
-> [CgStgTopBinding] -- ^ Bindings come already annotated with fvs
- -> HpcInfo
-> IO (CgStream CmmGroupSRTs CmmCgInfos)
-- Note we produce a 'Stream' of CmmGroups, so that the
-- backend can be run incrementally. Otherwise it generates all
-- the C-- up front, which has a significant space cost.
doCodeGen hsc_env this_mod denv data_tycons
- cost_centre_info stg_binds_w_fvs hpc_info = do
+ cost_centre_info stg_binds_w_fvs = do
let dflags = hsc_dflags hsc_env
logger = hsc_logger hsc_env
hooks = hsc_hooks hsc_env
@@ -2308,14 +2305,14 @@ doCodeGen hsc_env this_mod denv data_tycons
putDumpFileMaybe logger Opt_D_dump_stg_final "Final STG:" FormatSTG
(pprGenStgTopBindings stg_ppr_opts stg_binds_w_fvs)
- let stg_to_cmm dflags mod a b c d e = case stgToCmmHook hooks of
- Nothing -> StgToCmm.codeGen logger tmpfs (initStgToCmmConfig dflags mod) a b c d e
- Just h -> (,emptyDetUFM) <$> h (initStgToCmmConfig dflags mod) a b c d e
+ let stg_to_cmm dflags mod a b c d = case stgToCmmHook hooks of
+ Nothing -> StgToCmm.codeGen logger tmpfs (initStgToCmmConfig dflags mod) a b c d
+ Just h -> (,emptyDetUFM) <$> h (initStgToCmmConfig dflags mod) a b c d
let cmm_stream :: CgStream CmmGroup (ModuleLFInfos, DetUniqFM)
-- See Note [Forcing of stg_binds]
cmm_stream = stg_binds_w_fvs `seqList` {-# SCC "StgToCmm" #-}
- stg_to_cmm dflags this_mod denv data_tycons cost_centre_info stg_binds_w_fvs hpc_info
+ stg_to_cmm dflags this_mod denv data_tycons cost_centre_info stg_binds_w_fvs
-- codegen consumes a stream of CmmGroup, and produces a new
-- stream of CmmGroup (not necessarily synchronised: one
=====================================
compiler/GHC/HsToCore/Coverage.hs
=====================================
@@ -117,7 +117,7 @@ hpcInitCode platform this_mod (HpcInfo tickCount hashNo)
= initializerCStub platform fn_name decls body
where
fn_name = mkInitializerStubLabel this_mod (fsLit "hpc")
- decls = text "extern StgWord64 " <> tickboxes <> text "[]" <> semi
+ decls = text "StgWord64 " <> tickboxes <> brackets (int tickCount) <> semi
body = text "hs_hpc_module" <>
parens (hcat (punctuate comma [
doubleQuotes full_name_str,
=====================================
compiler/GHC/Iface/Tidy.hs
=====================================
@@ -407,7 +407,6 @@ tidyProgram opts (ModGuts { mg_module = mod
, mg_deps = deps
, mg_foreign = foreign_stubs
, mg_foreign_files = foreign_files
- , mg_hpc_info = hpc_info
, mg_modBreaks = modBreaks
, mg_boot_exports = boot_exports
}) = do
@@ -480,7 +479,6 @@ tidyProgram opts (ModGuts { mg_module = mod
, cg_foreign = all_foreign_stubs
, cg_foreign_files = foreign_files
, cg_dep_pkgs = dep_direct_pkgs deps
- , cg_hpc_info = hpc_info
, cg_modBreaks = modBreaks
, cg_spt_entries = spt_entries
}
@@ -1567,4 +1565,3 @@ mustExposeTyCon no_trim_types exports tc
exported_con con = any (`elemNameSet` exports)
(dataConName con : dataConFieldLabels con)
-}
-
=====================================
compiler/GHC/StgToCmm.hs
=====================================
@@ -24,7 +24,6 @@ import GHC.StgToCmm.Layout
import GHC.StgToCmm.Utils
import GHC.StgToCmm.Closure
import GHC.StgToCmm.Config
-import GHC.StgToCmm.Hpc
import GHC.StgToCmm.Ticky
import GHC.StgToCmm.Types (ModuleLFInfos)
import GHC.StgToCmm.CgUtils (CgStream)
@@ -38,7 +37,6 @@ import GHC.Stg.Syntax
import GHC.Types.CostCentre
import GHC.Types.IPE
-import GHC.Types.HpcInfo
import GHC.Types.Id
import GHC.Types.Id.Info
import GHC.Types.RepType
@@ -52,7 +50,6 @@ import GHC.Core.DataCon
import GHC.Core.TyCon
import GHC.Core.Multiplicity
-import GHC.Unit.Module
import GHC.Utils.Error
import GHC.Utils.Outputable
@@ -77,13 +74,12 @@ codeGen :: Logger
-> [TyCon]
-> CollectedCCs -- (Local/global) cost-centres needing declaring/registering.
-> [CgStgTopBinding] -- Bindings to convert
- -> HpcInfo
-> CgStream CmmGroup (ModuleLFInfos, DetUniqFM) -- See Note [Deterministic Uniques in the CG] on CgStream
-- Output as a stream, so codegen can
-- be interleaved with output
codeGen logger tmpfs cfg (InfoTableProvMap denv _ _) data_tycons
- cost_centre_info stg_binds hpc_info
+ cost_centre_info stg_binds
= do { -- cg: run the code generator, and yield the resulting CmmGroup
-- Using an IORef to store the state is a bit crude, but otherwise
-- we would need to add a state monad layer which regresses
@@ -118,7 +114,7 @@ codeGen logger tmpfs cfg (InfoTableProvMap denv _ _) data_tycons
yield cmm
return a
- ; cg (mkModuleInit cost_centre_info (stgToCmmThisModule cfg) hpc_info)
+ ; cg (mkModuleInit cost_centre_info)
; mapM_ (cg . cgTopBinding logger tmpfs cfg) stg_binds
-- Put datatype_stuff after code_stuff, because the
@@ -281,13 +277,10 @@ cgTopRhs cfg rec bndr (StgRhsClosure fvs cc upd_flag args body _typ)
mkModuleInit
:: CollectedCCs -- cost centre info
- -> Module
- -> HpcInfo
-> FCode ()
-mkModuleInit cost_centre_info this_mod hpc_info
- = do { initHpc this_mod hpc_info
- ; initCostCentres cost_centre_info
+mkModuleInit cost_centre_info
+ = do { initCostCentres cost_centre_info
}
=====================================
compiler/GHC/StgToCmm/Config.hs
=====================================
@@ -46,7 +46,6 @@ data StgToCmmConfig = StgToCmmConfig
---------------------------------- Flags --------------------------------------
, stgToCmmLoopification :: !Bool -- ^ Loopification enabled (cf @-floopification@)
, stgToCmmAlignCheck :: !Bool -- ^ Insert alignment check (cf @-falignment-sanitisation@)
- , stgToCmmOptHpc :: !Bool -- ^ perform code generation for code coverage
, stgToCmmFastPAPCalls :: !Bool -- ^
, stgToCmmSCCProfiling :: !Bool -- ^ Check if cost-centre profiling is enabled
, stgToCmmEagerBlackHole :: !Bool -- ^
=====================================
compiler/GHC/StgToCmm/Hpc.hs
=====================================
@@ -6,13 +6,11 @@
--
-----------------------------------------------------------------------------
-module GHC.StgToCmm.Hpc ( initHpc, mkTickBox ) where
+module GHC.StgToCmm.Hpc ( mkTickBox ) where
import GHC.Prelude
import GHC.Platform
-import GHC.StgToCmm.Monad
-import GHC.StgToCmm.Utils
import GHC.Cmm.Graph
import GHC.Cmm.Expr
@@ -20,9 +18,7 @@ import GHC.Cmm.CLabel
import GHC.Cmm.Utils
import GHC.Unit.Module
-import GHC.Types.HpcInfo
-import Control.Monad
mkTickBox :: Platform -> Module -> Int -> CmmAGraph
mkTickBox platform mod n
@@ -34,16 +30,3 @@ mkTickBox platform mod n
tick_box = cmmIndex platform W64
(CmmLit $ CmmLabel $ mkHpcTicksLabel $ mod)
n
-
--- | Emit top-level tables for HPC and return code to initialise
-initHpc :: Module -> HpcInfo -> FCode ()
-initHpc _ NoHpcInfo{}
- = return ()
-initHpc this_mod (HpcInfo tickCount _hashNo)
- = do do_hpc <- stgToCmmOptHpc <$> getStgToCmmConfig
- when do_hpc $
- emitDataLits (mkHpcTicksLabel this_mod)
- [ CmmInt 0 W64
- | _ <- take tickCount [0 :: Int ..]
- ]
-
=====================================
compiler/GHC/Unit/Module/ModGuts.hs
=====================================
@@ -141,7 +141,6 @@ data CgGuts
cg_foreign_files :: ![(ForeignSrcLang, FilePath)],
cg_dep_pkgs :: !(Set UnitId), -- ^ Dependent packages, used to
-- generate #includes for C code gen
- cg_hpc_info :: !HpcInfo, -- ^ Program coverage tick box information
cg_modBreaks :: !(Maybe ModBreaks), -- ^ Module breakpoints
cg_spt_entries :: [SptEntry]
-- ^ Static pointer table entries for static forms defined in
=====================================
testsuite/tests/bytecode/T25510/Makefile
=====================================
@@ -0,0 +1,7 @@
+TOP=../../..
+include $(TOP)/mk/boilerplate.mk
+include $(TOP)/mk/test.mk
+
+T25510c:
+ '$(TEST_HC)' $(ghcThWayFlags) -fhpc -fbyte-code-and-object-code -c T25510A.hs
+ '$(TEST_HC)' $(ghcThWayFlags) -fhpc -fprefer-byte-code -c T25510B.hs
=====================================
testsuite/tests/bytecode/T25510/T25510A.hs
=====================================
@@ -0,0 +1,8 @@
+{-# LANGUAGE TemplateHaskellQuotes #-}
+
+module T25510A where
+
+import Language.Haskell.TH
+
+a :: Q Exp
+a = [| 114514 |]
=====================================
testsuite/tests/bytecode/T25510/T25510B.hs
=====================================
@@ -0,0 +1,7 @@
+{-# LANGUAGE TemplateHaskell #-}
+
+module T25510B where
+
+import T25510A
+
+b = $(a)
=====================================
testsuite/tests/bytecode/T25510/all.T
=====================================
@@ -0,0 +1,10 @@
+test('T25510', [
+ req_th,
+ js_skip
+], multimod_compile, ['T25510B', '-fhpc -fbyte-code-and-object-code -fprefer-byte-code -v0'])
+
+test('T25510c', [
+ extra_files(['T25510A.hs', 'T25510B.hs']),
+ req_th,
+ js_skip
+], makefile_test, ['T25510c ghcThWayFlags=' + config.ghc_th_way_flags])
=====================================
testsuite/tests/wasm/should_run/control-flow/LoadCmmGroup.hs
=====================================
@@ -34,7 +34,6 @@ import GHC.Stg.FVs
import GHC.Stg.Syntax
import GHC.StgToCmm (codeGen)
import GHC.Types.CostCentre (emptyCollectedCCs)
-import GHC.Types.HpcInfo (emptyHpcInfo)
import GHC.Types.IPE (emptyInfoTableProvMap)
import GHC.Types.Unique.DSM
import GHC.Unit.Home
@@ -70,14 +69,12 @@ cmmOfSummary summ = do
tycons = []
ccs = emptyCollectedCCs
stg' = fmap fst (depSortWithAnnotStgPgm (ms_mod summ) stg)
- hpcinfo = emptyHpcInfo False
tmpfs = hsc_tmpfs env
- stg_to_cmm dflags mod = codeGen logger tmpfs (initStgToCmmConfig dflags mod)
(groups, _infos) <-
liftIO $ fmap fst $
runUDSMT (initDUniqSupply 't' 0) $
collectAll $
- stg_to_cmm dflags (ms_mod summ) infotable tycons ccs stg' hpcinfo
+ codeGen logger tmpfs (initStgToCmmConfig dflags (ms_mod summ)) infotable tycons ccs stg'
return groups
frontend :: DynFlags -> HscEnv -> ModSummary -> IO ModGuts
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/bcbcdaaf2df58e3b7a2756d044c4169a724e03d9
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/bcbcdaaf2df58e3b7a2756d044c4169a724e03d9
You're receiving this email because of your account on gitlab.haskell.org.
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20241121/af816517/attachment-0001.html>
More information about the ghc-commits
mailing list