Hannes Siebenhandl pushed to branch wip/fendor/ghci-debugger-unitid at Glasgow Haskell Compiler / GHC
Commits:
-
2e204269
by Andreas Klebinger at 2025-04-22T12:20:41+02:00
-
7250fc0c
by Matthew Pickering at 2025-04-22T16:24:04-04:00
-
d2dc89b4
by Matthew Pickering at 2025-04-22T16:24:04-04:00
-
4d463c97
by fendor at 2025-04-23T12:24:28+02:00
16 changed files:
- compiler/GHC/ByteCode/Asm.hs
- compiler/GHC/ByteCode/Instr.hs
- compiler/GHC/ByteCode/Types.hs
- compiler/GHC/Core/Opt/ConstantFold.hs
- compiler/GHC/Driver/Downsweep.hs
- compiler/GHC/Driver/Make.hs
- compiler/GHC/HsToCore/Breakpoints.hs
- compiler/GHC/Runtime/Eval.hs
- compiler/GHC/Runtime/Interpreter.hs
- compiler/GHC/StgToByteCode.hs
- libraries/ghci/GHCi/Message.hs
- libraries/ghci/GHCi/Run.hs
- rts/Exception.cmm
- rts/Interpreter.c
- + testsuite/tests/simplCore/should_compile/T25976.hs
- testsuite/tests/simplCore/should_compile/all.T
Changes:
| ... | ... | @@ -732,13 +732,16 @@ assembleI platform i = case i of |
| 732 | 732 | CCALL off m_addr i -> do np <- addr m_addr
|
| 733 | 733 | emit_ bci_CCALL [wOp off, Op np, SmallOp i]
|
| 734 | 734 | PRIMCALL -> emit_ bci_PRIMCALL []
|
| 735 | - BRK_FUN arr tick_mod tickx info_mod infox cc ->
|
|
| 735 | + BRK_FUN arr tick_mod tick_mod_id tickx info_mod info_mod_id infox cc ->
|
|
| 736 | 736 | do p1 <- ptr (BCOPtrBreakArray arr)
|
| 737 | 737 | tick_addr <- addr tick_mod
|
| 738 | + tick_unitid_addr <- addr tick_mod_id
|
|
| 738 | 739 | info_addr <- addr info_mod
|
| 740 | + info_unitid_addr <- addr info_mod_id
|
|
| 739 | 741 | np <- addr cc
|
| 740 | 742 | emit_ bci_BRK_FUN [ Op p1
|
| 741 | 743 | , Op tick_addr, Op info_addr
|
| 744 | + , Op tick_unitid_addr, Op info_unitid_addr
|
|
| 742 | 745 | , SmallOp tickx, SmallOp infox
|
| 743 | 746 | , Op np
|
| 744 | 747 | ]
|
| ... | ... | @@ -37,6 +37,7 @@ import GHC.Stg.Syntax |
| 37 | 37 | import GHCi.BreakArray (BreakArray)
|
| 38 | 38 | import Language.Haskell.Syntax.Module.Name (ModuleName)
|
| 39 | 39 | import GHC.Types.Unique
|
| 40 | +import GHC.Unit.Types (UnitId)
|
|
| 40 | 41 | |
| 41 | 42 | -- ----------------------------------------------------------------------------
|
| 42 | 43 | -- Bytecode instructions
|
| ... | ... | @@ -233,8 +234,10 @@ data BCInstr |
| 233 | 234 | -- Breakpoints
|
| 234 | 235 | | BRK_FUN (ForeignRef BreakArray)
|
| 235 | 236 | (RemotePtr ModuleName) -- breakpoint tick module
|
| 237 | + (RemotePtr UnitId) -- breakpoint tick module unit id
|
|
| 236 | 238 | !Word16 -- breakpoint tick index
|
| 237 | 239 | (RemotePtr ModuleName) -- breakpoint info module
|
| 240 | + (RemotePtr UnitId) -- breakpoint info module unit id
|
|
| 238 | 241 | !Word16 -- breakpoint info index
|
| 239 | 242 | (RemotePtr CostCentre)
|
| 240 | 243 | |
| ... | ... | @@ -403,10 +406,10 @@ instance Outputable BCInstr where |
| 403 | 406 | ppr ENTER = text "ENTER"
|
| 404 | 407 | ppr (RETURN pk) = text "RETURN " <+> ppr pk
|
| 405 | 408 | ppr (RETURN_TUPLE) = text "RETURN_TUPLE"
|
| 406 | - ppr (BRK_FUN _ _tick_mod tickx _info_mod infox _)
|
|
| 409 | + ppr (BRK_FUN _ _tick_mod _tick_mod_id tickx _info_mod _info_mod_id infox _)
|
|
| 407 | 410 | = text "BRK_FUN" <+> text "<breakarray>"
|
| 408 | - <+> text "<tick_module>" <+> ppr tickx
|
|
| 409 | - <+> text "<info_module>" <+> ppr infox
|
|
| 411 | + <+> text "<tick_module>" <+> text "<tick_module_unitid>" <+> ppr tickx
|
|
| 412 | + <+> text "<info_module>" <+> text "<info_module_unitid>" <+> ppr infox
|
|
| 410 | 413 | <+> text "<cc>"
|
| 411 | 414 | #if MIN_VERSION_rts(1,0,3)
|
| 412 | 415 | ppr (BCO_NAME nm) = text "BCO_NAME" <+> text (show nm)
|
| ... | ... | @@ -50,6 +50,7 @@ import GHC.Stack.CCS |
| 50 | 50 | import GHC.Cmm.Expr ( GlobalRegSet, emptyRegSet, regSetToList )
|
| 51 | 51 | import GHC.Iface.Syntax
|
| 52 | 52 | import Language.Haskell.Syntax.Module.Name (ModuleName)
|
| 53 | +import GHC.Unit.Types (UnitId)
|
|
| 53 | 54 | |
| 54 | 55 | -- -----------------------------------------------------------------------------
|
| 55 | 56 | -- Compiled Byte Code
|
| ... | ... | @@ -263,6 +264,9 @@ data ModBreaks |
| 263 | 264 | , modBreaks_breakInfo :: IntMap CgBreakInfo
|
| 264 | 265 | -- ^ info about each breakpoint from the bytecode generator
|
| 265 | 266 | , modBreaks_module :: RemotePtr ModuleName
|
| 267 | + -- ^ info about the module in which we are setting the breakpoint
|
|
| 268 | + , modBreaks_module_unitid :: RemotePtr UnitId
|
|
| 269 | + -- ^ The 'UnitId' of the 'ModuleName'
|
|
| 266 | 270 | }
|
| 267 | 271 | |
| 268 | 272 | seqModBreaks :: ModBreaks -> ()
|
| ... | ... | @@ -273,7 +277,8 @@ seqModBreaks ModBreaks{..} = |
| 273 | 277 | rnf modBreaks_decls `seq`
|
| 274 | 278 | rnf modBreaks_ccs `seq`
|
| 275 | 279 | rnf (fmap seqCgBreakInfo modBreaks_breakInfo) `seq`
|
| 276 | - rnf modBreaks_module
|
|
| 280 | + rnf modBreaks_module `seq`
|
|
| 281 | + rnf modBreaks_module_unitid
|
|
| 277 | 282 | |
| 278 | 283 | -- | Construct an empty ModBreaks
|
| 279 | 284 | emptyModBreaks :: ModBreaks
|
| ... | ... | @@ -286,6 +291,7 @@ emptyModBreaks = ModBreaks |
| 286 | 291 | , modBreaks_ccs = array (0,-1) []
|
| 287 | 292 | , modBreaks_breakInfo = IntMap.empty
|
| 288 | 293 | , modBreaks_module = toRemotePtr nullPtr
|
| 294 | + , modBreaks_module_unitid = toRemotePtr nullPtr
|
|
| 289 | 295 | }
|
| 290 | 296 | |
| 291 | 297 | {-
|
| ... | ... | @@ -69,7 +69,6 @@ import GHC.Cmm.MachOp ( FMASign(..) ) |
| 69 | 69 | import GHC.Cmm.Type ( Width(..) )
|
| 70 | 70 | |
| 71 | 71 | import GHC.Data.FastString
|
| 72 | -import GHC.Data.Maybe ( orElse )
|
|
| 73 | 72 | |
| 74 | 73 | import GHC.Utils.Outputable
|
| 75 | 74 | import GHC.Utils.Misc
|
| ... | ... | @@ -1997,6 +1996,14 @@ because we don't expect the user to call tagToEnum# at all; we merely |
| 1997 | 1996 | generate calls in derived instances of Enum. So we compromise: a
|
| 1998 | 1997 | rewrite rule rewrites a bad instance of tagToEnum# to an error call,
|
| 1999 | 1998 | and emits a warning.
|
| 1999 | + |
|
| 2000 | +We also do something similar if we can see that the argument of tagToEnum is out
|
|
| 2001 | +of bounds, e.g. `tagToEnum# 99# :: Bool`.
|
|
| 2002 | +Replacing this with an error expression is better for two reasons:
|
|
| 2003 | +* It allow us to eliminate more dead code in cases like `case tagToEnum# 99# :: Bool of ...`
|
|
| 2004 | +* Should we actually end up executing the relevant code at runtime the user will
|
|
| 2005 | + see a meaningful error message, instead of a segfault or incorrect result.
|
|
| 2006 | +See #25976.
|
|
| 2000 | 2007 | -}
|
| 2001 | 2008 | |
| 2002 | 2009 | tagToEnumRule :: RuleM CoreExpr
|
| ... | ... | @@ -2008,9 +2015,13 @@ tagToEnumRule = do |
| 2008 | 2015 | Just (tycon, tc_args) | isEnumerationTyCon tycon -> do
|
| 2009 | 2016 | let tag = fromInteger i
|
| 2010 | 2017 | correct_tag dc = (dataConTagZ dc) == tag
|
| 2011 | - (dc:rest) <- return $ filter correct_tag (tyConDataCons_maybe tycon `orElse` [])
|
|
| 2012 | - massert (null rest)
|
|
| 2013 | - return $ mkTyApps (Var (dataConWorkId dc)) tc_args
|
|
| 2018 | + Just dataCons <- pure $ tyConDataCons_maybe tycon
|
|
| 2019 | + case filter correct_tag dataCons of
|
|
| 2020 | + (dc:rest) -> do
|
|
| 2021 | + massert (null rest)
|
|
| 2022 | + pure $ mkTyApps (Var (dataConWorkId dc)) tc_args
|
|
| 2023 | + -- Literal is out of range, e.g. tagToEnum @Bool #4
|
|
| 2024 | + [] -> pure $ mkImpossibleExpr ty "tagToEnum: Argument out of range"
|
|
| 2014 | 2025 | |
| 2015 | 2026 | -- See Note [tagToEnum#]
|
| 2016 | 2027 | _ -> warnPprTrace True "tagToEnum# on non-enumeration type" (ppr ty) $
|
| ... | ... | @@ -947,6 +947,71 @@ enableCodeGenWhen logger tmpfs staticLife dynLife unit_env mod_graph = do |
| 947 | 947 | hostFullWays
|
| 948 | 948 | in dflags_c
|
| 949 | 949 | |
| 950 | +{- Note [-fno-code mode]
|
|
| 951 | +~~~~~~~~~~~~~~~~~~~~~~~~
|
|
| 952 | +GHC offers the flag -fno-code for the purpose of parsing and typechecking a
|
|
| 953 | +program without generating object files. This is intended to be used by tooling
|
|
| 954 | +and IDEs to provide quick feedback on any parser or type errors as cheaply as
|
|
| 955 | +possible.
|
|
| 956 | + |
|
| 957 | +When GHC is invoked with -fno-code, no object files or linked output will be
|
|
| 958 | +generated. As many errors and warnings as possible will be generated, as if
|
|
| 959 | +-fno-code had not been passed. The session DynFlags will have
|
|
| 960 | +backend == NoBackend.
|
|
| 961 | + |
|
| 962 | +-fwrite-interface
|
|
| 963 | +~~~~~~~~~~~~~~~~
|
|
| 964 | +Whether interface files are generated in -fno-code mode is controlled by the
|
|
| 965 | +-fwrite-interface flag. The -fwrite-interface flag is a no-op if -fno-code is
|
|
| 966 | +not also passed. Recompilation avoidance requires interface files, so passing
|
|
| 967 | +-fno-code without -fwrite-interface should be avoided. If -fno-code were
|
|
| 968 | +re-implemented today, there would be no need for -fwrite-interface as it
|
|
| 969 | +would considered always on; this behaviour is as it is for backwards compatibility.
|
|
| 970 | + |
|
| 971 | +================================================================
|
|
| 972 | +IN SUMMARY: ALWAYS PASS -fno-code AND -fwrite-interface TOGETHER
|
|
| 973 | +================================================================
|
|
| 974 | + |
|
| 975 | +Template Haskell
|
|
| 976 | +~~~~~~~~~~~~~~~~
|
|
| 977 | +A module using Template Haskell may invoke an imported function from inside a
|
|
| 978 | +splice. This will cause the type-checker to attempt to execute that code, which
|
|
| 979 | +would fail if no object files had been generated. See #8025. To rectify this,
|
|
| 980 | +during the downsweep we patch the DynFlags in the ModSummary of any home module
|
|
| 981 | +that is imported by a module that uses Template Haskell to generate object
|
|
| 982 | +code.
|
|
| 983 | + |
|
| 984 | +The flavour of the generated code depends on whether `-fprefer-byte-code` is enabled
|
|
| 985 | +or not in the module which needs the code generation. If the module requires byte-code then
|
|
| 986 | +dependencies will generate byte-code, otherwise they will generate object files.
|
|
| 987 | +In the case where some modules require byte-code and some object files, both are
|
|
| 988 | +generated by enabling `-fbyte-code-and-object-code`, the test "fat015" tests these
|
|
| 989 | +configurations.
|
|
| 990 | + |
|
| 991 | +The object files (and interface files if -fwrite-interface is disabled) produced
|
|
| 992 | +for Template Haskell are written to temporary files.
|
|
| 993 | + |
|
| 994 | +Note that since Template Haskell can run arbitrary IO actions, -fno-code mode
|
|
| 995 | +is no more secure than running without it.
|
|
| 996 | + |
|
| 997 | +Potential TODOS:
|
|
| 998 | +~~~~~
|
|
| 999 | +* Remove -fwrite-interface and have interface files always written in -fno-code
|
|
| 1000 | + mode
|
|
| 1001 | +* Both .o and .dyn_o files are generated for template haskell, but we only need
|
|
| 1002 | + .dyn_o. Fix it.
|
|
| 1003 | +* In make mode, a message like
|
|
| 1004 | + Compiling A (A.hs, /tmp/ghc_123.o)
|
|
| 1005 | + is shown if downsweep enabled object code generation for A. Perhaps we should
|
|
| 1006 | + show "nothing" or "temporary object file" instead. Note that one
|
|
| 1007 | + can currently use -keep-tmp-files and inspect the generated file with the
|
|
| 1008 | + current behaviour.
|
|
| 1009 | +* Offer a -no-codedir command line option, and write what were temporary
|
|
| 1010 | + object files there. This would speed up recompilation.
|
|
| 1011 | +* Use existing object files (if they are up to date) instead of always
|
|
| 1012 | + generating temporary ones.
|
|
| 1013 | +-}
|
|
| 1014 | + |
|
| 950 | 1015 | -- | Populate the Downsweep cache with the root modules.
|
| 951 | 1016 | mkRootMap
|
| 952 | 1017 | :: [ModuleNodeInfo]
|
| ... | ... | @@ -1246,70 +1246,6 @@ addSptEntries hsc_env mlinkable = |
| 1246 | 1246 | , spt <- bc_spt_entries bco
|
| 1247 | 1247 | ]
|
| 1248 | 1248 | |
| 1249 | -{- Note [-fno-code mode]
|
|
| 1250 | -~~~~~~~~~~~~~~~~~~~~~~~~
|
|
| 1251 | -GHC offers the flag -fno-code for the purpose of parsing and typechecking a
|
|
| 1252 | -program without generating object files. This is intended to be used by tooling
|
|
| 1253 | -and IDEs to provide quick feedback on any parser or type errors as cheaply as
|
|
| 1254 | -possible.
|
|
| 1255 | - |
|
| 1256 | -When GHC is invoked with -fno-code no object files or linked output will be
|
|
| 1257 | -generated. As many errors and warnings as possible will be generated, as if
|
|
| 1258 | --fno-code had not been passed. The session DynFlags will have
|
|
| 1259 | -backend == NoBackend.
|
|
| 1260 | - |
|
| 1261 | --fwrite-interface
|
|
| 1262 | -~~~~~~~~~~~~~~~~
|
|
| 1263 | -Whether interface files are generated in -fno-code mode is controlled by the
|
|
| 1264 | --fwrite-interface flag. The -fwrite-interface flag is a no-op if -fno-code is
|
|
| 1265 | -not also passed. Recompilation avoidance requires interface files, so passing
|
|
| 1266 | --fno-code without -fwrite-interface should be avoided. If -fno-code were
|
|
| 1267 | -re-implemented today, -fwrite-interface would be discarded and it would be
|
|
| 1268 | -considered always on; this behaviour is as it is for backwards compatibility.
|
|
| 1269 | - |
|
| 1270 | -================================================================
|
|
| 1271 | -IN SUMMARY: ALWAYS PASS -fno-code AND -fwrite-interface TOGETHER
|
|
| 1272 | -================================================================
|
|
| 1273 | - |
|
| 1274 | -Template Haskell
|
|
| 1275 | -~~~~~~~~~~~~~~~~
|
|
| 1276 | -A module using template haskell may invoke an imported function from inside a
|
|
| 1277 | -splice. This will cause the type-checker to attempt to execute that code, which
|
|
| 1278 | -would fail if no object files had been generated. See #8025. To rectify this,
|
|
| 1279 | -during the downsweep we patch the DynFlags in the ModSummary of any home module
|
|
| 1280 | -that is imported by a module that uses template haskell, to generate object
|
|
| 1281 | -code.
|
|
| 1282 | - |
|
| 1283 | -The flavour of the generated code depends on whether `-fprefer-byte-code` is enabled
|
|
| 1284 | -or not in the module which needs the code generation. If the module requires byte-code then
|
|
| 1285 | -dependencies will generate byte-code, otherwise they will generate object files.
|
|
| 1286 | -In the case where some modules require byte-code and some object files, both are
|
|
| 1287 | -generated by enabling `-fbyte-code-and-object-code`, the test "fat015" tests these
|
|
| 1288 | -configurations.
|
|
| 1289 | - |
|
| 1290 | -The object files (and interface files if -fwrite-interface is disabled) produced
|
|
| 1291 | -for template haskell are written to temporary files.
|
|
| 1292 | - |
|
| 1293 | -Note that since template haskell can run arbitrary IO actions, -fno-code mode
|
|
| 1294 | -is no more secure than running without it.
|
|
| 1295 | - |
|
| 1296 | -Potential TODOS:
|
|
| 1297 | -~~~~~
|
|
| 1298 | -* Remove -fwrite-interface and have interface files always written in -fno-code
|
|
| 1299 | - mode
|
|
| 1300 | -* Both .o and .dyn_o files are generated for template haskell, but we only need
|
|
| 1301 | - .dyn_o. Fix it.
|
|
| 1302 | -* In make mode, a message like
|
|
| 1303 | - Compiling A (A.hs, /tmp/ghc_123.o)
|
|
| 1304 | - is shown if downsweep enabled object code generation for A. Perhaps we should
|
|
| 1305 | - show "nothing" or "temporary object file" instead. Note that one
|
|
| 1306 | - can currently use -keep-tmp-files and inspect the generated file with the
|
|
| 1307 | - current behaviour.
|
|
| 1308 | -* Offer a -no-codedir command line option, and write what were temporary
|
|
| 1309 | - object files there. This would speed up recompilation.
|
|
| 1310 | -* Use existing object files (if they are up to date) instead of always
|
|
| 1311 | - generating temporary ones.
|
|
| 1312 | --}
|
|
| 1313 | 1249 | |
| 1314 | 1250 | -- Note [When source is considered modified]
|
| 1315 | 1251 | -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
|
| ... | ... | @@ -34,7 +34,7 @@ mkModBreaks interp mod extendedMixEntries |
| 34 | 34 | |
| 35 | 35 | breakArray <- GHCi.newBreakArray interp count
|
| 36 | 36 | ccs <- mkCCSArray interp mod count entries
|
| 37 | - mod_ptr <- GHCi.newModuleName interp (moduleName mod)
|
|
| 37 | + (mod_ptr, mod_id_ptr) <- GHCi.newModule interp mod
|
|
| 38 | 38 | let
|
| 39 | 39 | locsTicks = listArray (0,count-1) [ tick_loc t | t <- entries ]
|
| 40 | 40 | varsTicks = listArray (0,count-1) [ tick_ids t | t <- entries ]
|
| ... | ... | @@ -46,6 +46,7 @@ mkModBreaks interp mod extendedMixEntries |
| 46 | 46 | , modBreaks_decls = declsTicks
|
| 47 | 47 | , modBreaks_ccs = ccs
|
| 48 | 48 | , modBreaks_module = mod_ptr
|
| 49 | + , modBreaks_module_unitid = mod_id_ptr
|
|
| 49 | 50 | }
|
| 50 | 51 | |
| 51 | 52 | mkCCSArray
|
| ... | ... | @@ -345,7 +345,7 @@ handleRunStatus step expr bindings final_ids status history0 = do |
| 345 | 345 | |
| 346 | 346 | -- Just case: we stopped at a breakpoint
|
| 347 | 347 | EvalBreak apStack_ref (Just eval_break) resume_ctxt ccs -> do
|
| 348 | - ibi <- liftIO $ evalBreakpointToId (hsc_HPT hsc_env) eval_break
|
|
| 348 | + let ibi = evalBreakpointToId eval_break
|
|
| 349 | 349 | tick_brks <- liftIO $ readModBreaks hsc_env (ibi_tick_mod ibi)
|
| 350 | 350 | let
|
| 351 | 351 | span = modBreaks_locs tick_brks ! ibi_tick_index ibi
|
| ... | ... | @@ -21,7 +21,7 @@ module GHC.Runtime.Interpreter |
| 21 | 21 | , mkCostCentres
|
| 22 | 22 | , costCentreStackInfo
|
| 23 | 23 | , newBreakArray
|
| 24 | - , newModuleName
|
|
| 24 | + , newModule
|
|
| 25 | 25 | , storeBreakpoint
|
| 26 | 26 | , breakpointStatus
|
| 27 | 27 | , getBreakpointVar
|
| ... | ... | @@ -93,9 +93,7 @@ import GHC.Utils.Outputable(brackets, ppr, showSDocUnsafe) |
| 93 | 93 | import GHC.Utils.Fingerprint
|
| 94 | 94 | |
| 95 | 95 | import GHC.Unit.Module
|
| 96 | -import GHC.Unit.Module.ModIface
|
|
| 97 | 96 | import GHC.Unit.Home.ModInfo
|
| 98 | -import GHC.Unit.Home.PackageTable
|
|
| 99 | 97 | import GHC.Unit.Env
|
| 100 | 98 | |
| 101 | 99 | #if defined(HAVE_INTERNAL_INTERPRETER)
|
| ... | ... | @@ -119,6 +117,7 @@ import qualified GHC.InfoProv as InfoProv |
| 119 | 117 | |
| 120 | 118 | import GHC.Builtin.Names
|
| 121 | 119 | import GHC.Types.Name
|
| 120 | +import qualified GHC.Unit.Home.Graph as HUG
|
|
| 122 | 121 | |
| 123 | 122 | -- Standard libraries
|
| 124 | 123 | import GHC.Exts
|
| ... | ... | @@ -377,9 +376,13 @@ newBreakArray interp size = do |
| 377 | 376 | breakArray <- interpCmd interp (NewBreakArray size)
|
| 378 | 377 | mkFinalizedHValue interp breakArray
|
| 379 | 378 | |
| 380 | -newModuleName :: Interp -> ModuleName -> IO (RemotePtr ModuleName)
|
|
| 381 | -newModuleName interp mod_name =
|
|
| 382 | - castRemotePtr <$> interpCmd interp (NewBreakModule (moduleNameString mod_name))
|
|
| 379 | +newModule :: Interp -> Module -> IO (RemotePtr ModuleName, RemotePtr UnitId)
|
|
| 380 | +newModule interp mod = do
|
|
| 381 | + let
|
|
| 382 | + mod_name = moduleNameString $ moduleName mod
|
|
| 383 | + mod_id = fastStringToShortByteString $ unitIdFS $ toUnitId $ moduleUnit mod
|
|
| 384 | + (mod_ptr, mod_id_ptr) <- interpCmd interp (NewBreakModule mod_name mod_id)
|
|
| 385 | + pure (castRemotePtr mod_ptr, castRemotePtr mod_id_ptr)
|
|
| 383 | 386 | |
| 384 | 387 | storeBreakpoint :: Interp -> ForeignRef BreakArray -> Int -> Int -> IO ()
|
| 385 | 388 | storeBreakpoint interp ref ix cnt = do -- #19157
|
| ... | ... | @@ -415,19 +418,21 @@ seqHValue interp unit_env ref = |
| 415 | 418 | status <- interpCmd interp (Seq hval)
|
| 416 | 419 | handleSeqHValueStatus interp unit_env status
|
| 417 | 420 | |
| 418 | -evalBreakpointToId :: HomePackageTable -> EvalBreakpoint -> IO InternalBreakpointId
|
|
| 419 | -evalBreakpointToId hpt eval_break =
|
|
| 420 | - let load_mod x = mi_module . hm_iface . expectJust <$> lookupHpt hpt (mkModuleName x)
|
|
| 421 | - in do
|
|
| 422 | - tickl <- load_mod (eb_tick_mod eval_break)
|
|
| 423 | - infol <- load_mod (eb_info_mod eval_break)
|
|
| 424 | - return
|
|
| 425 | - InternalBreakpointId
|
|
| 426 | - { ibi_tick_mod = tickl
|
|
| 427 | - , ibi_tick_index = eb_tick_index eval_break
|
|
| 428 | - , ibi_info_mod = infol
|
|
| 429 | - , ibi_info_index = eb_info_index eval_break
|
|
| 430 | - }
|
|
| 421 | +evalBreakpointToId :: EvalBreakpoint -> InternalBreakpointId
|
|
| 422 | +evalBreakpointToId eval_break =
|
|
| 423 | + let
|
|
| 424 | + mkUnitId u = fsToUnit $ mkFastStringShortByteString u
|
|
| 425 | + |
|
| 426 | + toModule u n = mkModule (mkUnitId u) (mkModuleName n)
|
|
| 427 | + tickl = toModule (eb_tick_mod_unit eval_break) (eb_tick_mod eval_break)
|
|
| 428 | + infol = toModule (eb_info_mod_unit eval_break) (eb_info_mod eval_break)
|
|
| 429 | + in
|
|
| 430 | + InternalBreakpointId
|
|
| 431 | + { ibi_tick_mod = tickl
|
|
| 432 | + , ibi_tick_index = eb_tick_index eval_break
|
|
| 433 | + , ibi_info_mod = infol
|
|
| 434 | + , ibi_info_index = eb_info_index eval_break
|
|
| 435 | + }
|
|
| 431 | 436 | |
| 432 | 437 | -- | Process the result of a Seq or ResumeSeq message. #2950
|
| 433 | 438 | handleSeqHValueStatus :: Interp -> UnitEnv -> EvalStatus () -> IO (EvalResult ())
|
| ... | ... | @@ -447,12 +452,12 @@ handleSeqHValueStatus interp unit_env eval_status = |
| 447 | 452 | mkGeneralSrcSpan (fsLit "<unknown>")
|
| 448 | 453 | |
| 449 | 454 | Just break -> do
|
| 450 | - bi <- evalBreakpointToId (ue_hpt unit_env) break
|
|
| 455 | + let bi = evalBreakpointToId break
|
|
| 451 | 456 | |
| 452 | 457 | -- Just case: Stopped at a breakpoint, extract SrcSpan information
|
| 453 | 458 | -- from the breakpoint.
|
| 454 | 459 | breaks_tick <- getModBreaks . expectJust <$>
|
| 455 | - lookupHpt (ue_hpt unit_env) (moduleName (ibi_tick_mod bi))
|
|
| 460 | + HUG.lookupHugByModule (ibi_tick_mod bi) (ue_home_unit_graph unit_env)
|
|
| 456 | 461 | put $ brackets . ppr $
|
| 457 | 462 | (modBreaks_locs breaks_tick) ! ibi_tick_index bi
|
| 458 | 463 |
| ... | ... | @@ -416,7 +416,7 @@ schemeER_wrk d p (StgTick (Breakpoint tick_ty tick_no fvs tick_mod) rhs) = do |
| 416 | 416 | Nothing -> pure code
|
| 417 | 417 | Just current_mod_breaks -> break_info hsc_env tick_mod current_mod mb_current_mod_breaks >>= \case
|
| 418 | 418 | Nothing -> pure code
|
| 419 | - Just ModBreaks {modBreaks_flags = breaks, modBreaks_module = tick_mod_ptr, modBreaks_ccs = cc_arr} -> do
|
|
| 419 | + Just ModBreaks {modBreaks_flags = breaks, modBreaks_module = tick_mod_ptr, modBreaks_module_unitid = tick_mod_id_ptr, modBreaks_ccs = cc_arr} -> do
|
|
| 420 | 420 | platform <- profilePlatform <$> getProfile
|
| 421 | 421 | let idOffSets = getVarOffSets platform d p fvs
|
| 422 | 422 | ty_vars = tyCoVarsOfTypesWellScoped (tick_ty:map idType fvs)
|
| ... | ... | @@ -425,6 +425,7 @@ schemeER_wrk d p (StgTick (Breakpoint tick_ty tick_no fvs tick_mod) rhs) = do |
| 425 | 425 | breakInfo = dehydrateCgBreakInfo ty_vars (map toWord idOffSets) tick_ty
|
| 426 | 426 | |
| 427 | 427 | let info_mod_ptr = modBreaks_module current_mod_breaks
|
| 428 | + info_mod_id_ptr = modBreaks_module_unitid current_mod_breaks
|
|
| 428 | 429 | infox <- newBreakInfo breakInfo
|
| 429 | 430 | |
| 430 | 431 | let cc | Just interp <- hsc_interp hsc_env
|
| ... | ... | @@ -437,7 +438,7 @@ schemeER_wrk d p (StgTick (Breakpoint tick_ty tick_no fvs tick_mod) rhs) = do |
| 437 | 438 | in if fromIntegral r == x
|
| 438 | 439 | then r
|
| 439 | 440 | else pprPanic "schemeER_wrk: breakpoint tick/info index too large!" (ppr x)
|
| 440 | - breakInstr = BRK_FUN breaks tick_mod_ptr (toW16 tick_no) info_mod_ptr (toW16 infox) cc
|
|
| 441 | + breakInstr = BRK_FUN breaks tick_mod_ptr tick_mod_id_ptr (toW16 tick_no) info_mod_ptr info_mod_id_ptr (toW16 infox) cc
|
|
| 441 | 442 | return $ breakInstr `consOL` code
|
| 442 | 443 | schemeER_wrk d p rhs = schemeE d 0 p rhs
|
| 443 | 444 |
| ... | ... | @@ -23,6 +23,7 @@ module GHCi.Message |
| 23 | 23 | , getMessage, putMessage, getTHMessage, putTHMessage
|
| 24 | 24 | , Pipe, mkPipeFromHandles, mkPipeFromContinuations, remoteCall, remoteTHCall, readPipe, writePipe
|
| 25 | 25 | , BreakModule
|
| 26 | + , BreakUnitId
|
|
| 26 | 27 | , LoadedDLL
|
| 27 | 28 | ) where
|
| 28 | 29 | |
| ... | ... | @@ -62,6 +63,7 @@ import qualified GHC.Boot.TH.Syntax as TH |
| 62 | 63 | import System.Exit
|
| 63 | 64 | import System.IO
|
| 64 | 65 | import System.IO.Error
|
| 66 | +import qualified Data.ByteString.Short as BS
|
|
| 65 | 67 | |
| 66 | 68 | -- -----------------------------------------------------------------------------
|
| 67 | 69 | -- The RPC protocol between GHC and the interactive server
|
| ... | ... | @@ -245,8 +247,9 @@ data Message a where |
| 245 | 247 | -- | Allocate a string for a breakpoint module name.
|
| 246 | 248 | -- This uses an empty dummy type because @ModuleName@ isn't available here.
|
| 247 | 249 | NewBreakModule
|
| 248 | - :: String
|
|
| 249 | - -> Message (RemotePtr BreakModule)
|
|
| 250 | + :: String -- ^ @ModuleName@
|
|
| 251 | + -> BS.ShortByteString -- ^ @UnitId@ for the given @ModuleName@
|
|
| 252 | + -> Message (RemotePtr BreakModule, RemotePtr BreakUnitId)
|
|
| 250 | 253 | |
| 251 | 254 | |
| 252 | 255 | deriving instance Show (Message a)
|
| ... | ... | @@ -410,10 +413,12 @@ data EvalStatus_ a b |
| 410 | 413 | instance Binary a => Binary (EvalStatus_ a b)
|
| 411 | 414 | |
| 412 | 415 | data EvalBreakpoint = EvalBreakpoint
|
| 413 | - { eb_tick_mod :: String -- ^ Breakpoint tick module
|
|
| 414 | - , eb_tick_index :: Int -- ^ Breakpoint tick index
|
|
| 415 | - , eb_info_mod :: String -- ^ Breakpoint info module
|
|
| 416 | - , eb_info_index :: Int -- ^ Breakpoint info index
|
|
| 416 | + { eb_tick_mod :: String -- ^ Breakpoint tick module
|
|
| 417 | + , eb_tick_mod_unit :: BS.ShortByteString -- ^ Breakpoint tick module unit id
|
|
| 418 | + , eb_tick_index :: Int -- ^ Breakpoint tick index
|
|
| 419 | + , eb_info_mod :: String -- ^ Breakpoint info module
|
|
| 420 | + , eb_info_mod_unit :: BS.ShortByteString -- ^ Breakpoint tick module unit id
|
|
| 421 | + , eb_info_index :: Int -- ^ Breakpoint info index
|
|
| 417 | 422 | }
|
| 418 | 423 | deriving (Generic, Show)
|
| 419 | 424 | |
| ... | ... | @@ -430,6 +435,10 @@ instance Binary a => Binary (EvalResult a) |
| 430 | 435 | -- that type isn't available here.
|
| 431 | 436 | data BreakModule
|
| 432 | 437 | |
| 438 | +-- | A dummy type that tags the pointer to a breakpoint's @UnitId@, because
|
|
| 439 | +-- that type isn't available here.
|
|
| 440 | +data BreakUnitId
|
|
| 441 | + |
|
| 433 | 442 | -- | A dummy type that tags pointers returned by 'LoadDLL'.
|
| 434 | 443 | data LoadedDLL
|
| 435 | 444 | |
| ... | ... | @@ -580,7 +589,7 @@ getMessage = do |
| 580 | 589 | 36 -> Msg <$> (Seq <$> get)
|
| 581 | 590 | 37 -> Msg <$> return RtsRevertCAFs
|
| 582 | 591 | 38 -> Msg <$> (ResumeSeq <$> get)
|
| 583 | - 39 -> Msg <$> (NewBreakModule <$> get)
|
|
| 592 | + 39 -> Msg <$> (NewBreakModule <$> get <*> get)
|
|
| 584 | 593 | 40 -> Msg <$> (LookupSymbolInDLL <$> get <*> get)
|
| 585 | 594 | 41 -> Msg <$> (WhereFrom <$> get)
|
| 586 | 595 | _ -> error $ "Unknown Message code " ++ (show b)
|
| ... | ... | @@ -627,7 +636,7 @@ putMessage m = case m of |
| 627 | 636 | Seq a -> putWord8 36 >> put a
|
| 628 | 637 | RtsRevertCAFs -> putWord8 37
|
| 629 | 638 | ResumeSeq a -> putWord8 38 >> put a
|
| 630 | - NewBreakModule name -> putWord8 39 >> put name
|
|
| 639 | + NewBreakModule name unitid -> putWord8 39 >> put name >> put unitid
|
|
| 631 | 640 | LookupSymbolInDLL dll str -> putWord8 40 >> put dll >> put str
|
| 632 | 641 | WhereFrom a -> putWord8 41 >> put a
|
| 633 | 642 |
| ... | ... | @@ -43,6 +43,7 @@ import GHC.Conc.Sync |
| 43 | 43 | import GHC.IO hiding ( bracket )
|
| 44 | 44 | import System.Mem.Weak ( deRefWeak )
|
| 45 | 45 | import Unsafe.Coerce
|
| 46 | +import qualified Data.ByteString.Short as BS
|
|
| 46 | 47 | |
| 47 | 48 | -- -----------------------------------------------------------------------------
|
| 48 | 49 | -- Implement messages
|
| ... | ... | @@ -95,7 +96,10 @@ run m = case m of |
| 95 | 96 | MkCostCentres mod ccs -> mkCostCentres mod ccs
|
| 96 | 97 | CostCentreStackInfo ptr -> ccsToStrings (fromRemotePtr ptr)
|
| 97 | 98 | NewBreakArray sz -> mkRemoteRef =<< newBreakArray sz
|
| 98 | - NewBreakModule name -> newModuleName name
|
|
| 99 | + NewBreakModule name unitid -> do
|
|
| 100 | + namePtr <- newModuleName name
|
|
| 101 | + uidPtr <- newUnitId unitid
|
|
| 102 | + pure (namePtr, uidPtr)
|
|
| 99 | 103 | SetupBreakpoint ref ix cnt -> do
|
| 100 | 104 | arr <- localRef ref;
|
| 101 | 105 | _ <- setupBreakpoint arr ix cnt
|
| ... | ... | @@ -335,7 +339,7 @@ withBreakAction opts breakMVar statusMVar act |
| 335 | 339 | -- as soon as it is hit, or in resetBreakAction below.
|
| 336 | 340 | |
| 337 | 341 | onBreak :: BreakpointCallback
|
| 338 | - onBreak tick_mod# tickx# info_mod# infox# is_exception apStack = do
|
|
| 342 | + onBreak tick_mod# tick_mod_uid# tickx# info_mod# info_mod_uid# infox# is_exception apStack = do
|
|
| 339 | 343 | tid <- myThreadId
|
| 340 | 344 | let resume = ResumeContext
|
| 341 | 345 | { resumeBreakMVar = breakMVar
|
| ... | ... | @@ -349,8 +353,10 @@ withBreakAction opts breakMVar statusMVar act |
| 349 | 353 | then pure Nothing
|
| 350 | 354 | else do
|
| 351 | 355 | tick_mod <- peekCString (Ptr tick_mod#)
|
| 356 | + tick_mod_uid <- BS.packCString (Ptr tick_mod_uid#)
|
|
| 352 | 357 | info_mod <- peekCString (Ptr info_mod#)
|
| 353 | - pure (Just (EvalBreakpoint tick_mod (I# tickx#) info_mod (I# infox#)))
|
|
| 358 | + info_mod_uid <- BS.packCString (Ptr info_mod_uid#)
|
|
| 359 | + pure (Just (EvalBreakpoint tick_mod tick_mod_uid (I# tickx#) info_mod info_mod_uid (I# infox#)))
|
|
| 354 | 360 | putMVar statusMVar $ EvalBreak apStack_r breakpoint resume_r ccs
|
| 355 | 361 | takeMVar breakMVar
|
| 356 | 362 | |
| ... | ... | @@ -400,8 +406,10 @@ resetStepFlag = poke stepFlag 0 |
| 400 | 406 | |
| 401 | 407 | type BreakpointCallback
|
| 402 | 408 | = Addr# -- pointer to the breakpoint tick module name
|
| 409 | + -> Addr# -- pointer to the breakpoint tick module unit id
|
|
| 403 | 410 | -> Int# -- breakpoint tick index
|
| 404 | 411 | -> Addr# -- pointer to the breakpoint info module name
|
| 412 | + -> Addr# -- pointer to the breakpoint info module unit id
|
|
| 405 | 413 | -> Int# -- breakpoint info index
|
| 406 | 414 | -> Bool -- exception?
|
| 407 | 415 | -> HValue -- the AP_STACK, or exception
|
| ... | ... | @@ -414,8 +422,8 @@ noBreakStablePtr :: StablePtr BreakpointCallback |
| 414 | 422 | noBreakStablePtr = unsafePerformIO $ newStablePtr noBreakAction
|
| 415 | 423 | |
| 416 | 424 | noBreakAction :: BreakpointCallback
|
| 417 | -noBreakAction _ _ _ _ False _ = putStrLn "*** Ignoring breakpoint"
|
|
| 418 | -noBreakAction _ _ _ _ True _ = return () -- exception: just continue
|
|
| 425 | +noBreakAction _ _ _ _ _ _ False _ = putStrLn "*** Ignoring breakpoint"
|
|
| 426 | +noBreakAction _ _ _ _ _ _ True _ = return () -- exception: just continue
|
|
| 419 | 427 | |
| 420 | 428 | -- Malloc and copy the bytes. We don't have any way to monitor the
|
| 421 | 429 | -- lifetime of this memory, so it just leaks.
|
| ... | ... | @@ -432,6 +440,13 @@ mkString0 bs = B.unsafeUseAsCStringLen bs $ \(cstr,len) -> do |
| 432 | 440 | pokeElemOff (ptr :: Ptr CChar) len 0
|
| 433 | 441 | return (castRemotePtr (toRemotePtr ptr))
|
| 434 | 442 | |
| 443 | +mkShortByteString0 :: BS.ShortByteString -> IO (RemotePtr ())
|
|
| 444 | +mkShortByteString0 bs = BS.useAsCStringLen bs $ \(cstr,len) -> do
|
|
| 445 | + ptr <- mallocBytes (len+1)
|
|
| 446 | + copyBytes ptr cstr len
|
|
| 447 | + pokeElemOff (ptr :: Ptr CChar) len 0
|
|
| 448 | + return (castRemotePtr (toRemotePtr ptr))
|
|
| 449 | + |
|
| 435 | 450 | mkCostCentres :: String -> [(String,String)] -> IO [RemotePtr CostCentre]
|
| 436 | 451 | #if defined(PROFILING)
|
| 437 | 452 | mkCostCentres mod ccs = do
|
| ... | ... | @@ -453,6 +468,10 @@ newModuleName :: String -> IO (RemotePtr BreakModule) |
| 453 | 468 | newModuleName name =
|
| 454 | 469 | castRemotePtr . toRemotePtr <$> newCString name
|
| 455 | 470 | |
| 471 | +newUnitId :: BS.ShortByteString -> IO (RemotePtr BreakUnitId)
|
|
| 472 | +newUnitId name =
|
|
| 473 | + castRemotePtr <$> mkShortByteString0 name
|
|
| 474 | + |
|
| 456 | 475 | getIdValFromApStack :: HValue -> Int -> IO (Maybe HValue)
|
| 457 | 476 | getIdValFromApStack apStack (I# stackDepth) = do
|
| 458 | 477 | case getApStackVal# apStack stackDepth of
|
| ... | ... | @@ -535,12 +535,16 @@ retry_pop_stack: |
| 535 | 535 | // be per-thread.
|
| 536 | 536 | CInt[rts_stop_on_exception] = 0;
|
| 537 | 537 | ("ptr" ioAction) = ccall deRefStablePtr (W_[rts_breakpoint_io_action] "ptr");
|
| 538 | - Sp = Sp - WDS(13);
|
|
| 539 | - Sp(12) = exception;
|
|
| 540 | - Sp(11) = stg_raise_ret_info;
|
|
| 541 | - Sp(10) = exception;
|
|
| 542 | - Sp(9) = ghczminternal_GHCziInternalziTypes_True_closure; // True <=> an exception
|
|
| 543 | - Sp(8) = stg_ap_ppv_info;
|
|
| 538 | + Sp = Sp - WDS(17);
|
|
| 539 | + Sp(16) = exception;
|
|
| 540 | + Sp(15) = stg_raise_ret_info;
|
|
| 541 | + Sp(14) = exception;
|
|
| 542 | + Sp(13) = ghczminternal_GHCziInternalziTypes_True_closure; // True <=> an exception
|
|
| 543 | + Sp(12) = stg_ap_ppv_info;
|
|
| 544 | + Sp(11) = 0;
|
|
| 545 | + Sp(10) = stg_ap_n_info;
|
|
| 546 | + Sp(9) = 0;
|
|
| 547 | + Sp(8) = stg_ap_n_info;
|
|
| 544 | 548 | Sp(7) = 0;
|
| 545 | 549 | Sp(6) = stg_ap_n_info;
|
| 546 | 550 | Sp(5) = 0;
|
| ... | ... | @@ -1245,9 +1245,9 @@ run_BCO: |
| 1245 | 1245 | /* check for a breakpoint on the beginning of a let binding */
|
| 1246 | 1246 | case bci_BRK_FUN:
|
| 1247 | 1247 | {
|
| 1248 | - int arg1_brk_array, arg2_tick_mod, arg3_info_mod, arg4_tick_index, arg5_info_index;
|
|
| 1248 | + int arg1_brk_array, arg2_tick_mod, arg3_info_mod, arg4_tick_mod_id, arg5_info_mod_id, arg6_tick_index, arg7_info_index;
|
|
| 1249 | 1249 | #if defined(PROFILING)
|
| 1250 | - int arg6_cc;
|
|
| 1250 | + int arg8_cc;
|
|
| 1251 | 1251 | #endif
|
| 1252 | 1252 | StgArrBytes *breakPoints;
|
| 1253 | 1253 | int returning_from_break;
|
| ... | ... | @@ -1264,10 +1264,12 @@ run_BCO: |
| 1264 | 1264 | arg1_brk_array = BCO_GET_LARGE_ARG;
|
| 1265 | 1265 | arg2_tick_mod = BCO_GET_LARGE_ARG;
|
| 1266 | 1266 | arg3_info_mod = BCO_GET_LARGE_ARG;
|
| 1267 | - arg4_tick_index = BCO_NEXT;
|
|
| 1268 | - arg5_info_index = BCO_NEXT;
|
|
| 1267 | + arg4_tick_mod_id = BCO_GET_LARGE_ARG;
|
|
| 1268 | + arg5_info_mod_id = BCO_GET_LARGE_ARG;
|
|
| 1269 | + arg6_tick_index = BCO_NEXT;
|
|
| 1270 | + arg7_info_index = BCO_NEXT;
|
|
| 1269 | 1271 | #if defined(PROFILING)
|
| 1270 | - arg6_cc = BCO_GET_LARGE_ARG;
|
|
| 1272 | + arg8_cc = BCO_GET_LARGE_ARG;
|
|
| 1271 | 1273 | #else
|
| 1272 | 1274 | BCO_GET_LARGE_ARG;
|
| 1273 | 1275 | #endif
|
| ... | ... | @@ -1280,7 +1282,7 @@ run_BCO: |
| 1280 | 1282 | |
| 1281 | 1283 | #if defined(PROFILING)
|
| 1282 | 1284 | cap->r.rCCCS = pushCostCentre(cap->r.rCCCS,
|
| 1283 | - (CostCentre*)BCO_LIT(arg6_cc));
|
|
| 1285 | + (CostCentre*)BCO_LIT(arg8_cc));
|
|
| 1284 | 1286 | #endif
|
| 1285 | 1287 | |
| 1286 | 1288 | // if we are returning from a break then skip this section
|
| ... | ... | @@ -1292,11 +1294,11 @@ run_BCO: |
| 1292 | 1294 | // stop the current thread if either the
|
| 1293 | 1295 | // "rts_stop_next_breakpoint" flag is true OR if the
|
| 1294 | 1296 | // ignore count for this particular breakpoint is zero
|
| 1295 | - StgInt ignore_count = ((StgInt*)breakPoints->payload)[arg4_tick_index];
|
|
| 1297 | + StgInt ignore_count = ((StgInt*)breakPoints->payload)[arg6_tick_index];
|
|
| 1296 | 1298 | if (rts_stop_next_breakpoint == false && ignore_count > 0)
|
| 1297 | 1299 | {
|
| 1298 | 1300 | // decrement and write back ignore count
|
| 1299 | - ((StgInt*)breakPoints->payload)[arg4_tick_index] = --ignore_count;
|
|
| 1301 | + ((StgInt*)breakPoints->payload)[arg6_tick_index] = --ignore_count;
|
|
| 1300 | 1302 | }
|
| 1301 | 1303 | else if (rts_stop_next_breakpoint == true || ignore_count == 0)
|
| 1302 | 1304 | {
|
| ... | ... | @@ -1330,8 +1332,10 @@ run_BCO: |
| 1330 | 1332 | // continue execution of this BCO when the IO action returns.
|
| 1331 | 1333 | //
|
| 1332 | 1334 | // ioAction :: Addr# -- the breakpoint tick module
|
| 1335 | + // -> Addr# -- the breakpoint tick module unit id
|
|
| 1333 | 1336 | // -> Int# -- the breakpoint tick index
|
| 1334 | 1337 | // -> Addr# -- the breakpoint info module
|
| 1338 | + // -> Addr# -- the breakpoint info module unit id
|
|
| 1335 | 1339 | // -> Int# -- the breakpoint info index
|
| 1336 | 1340 | // -> Bool -- exception?
|
| 1337 | 1341 | // -> HValue -- the AP_STACK, or exception
|
| ... | ... | @@ -1340,17 +1344,21 @@ run_BCO: |
| 1340 | 1344 | ioAction = (StgClosure *) deRefStablePtr (
|
| 1341 | 1345 | rts_breakpoint_io_action);
|
| 1342 | 1346 | |
| 1343 | - Sp_subW(15);
|
|
| 1344 | - SpW(14) = (W_)obj;
|
|
| 1345 | - SpW(13) = (W_)&stg_apply_interp_info;
|
|
| 1346 | - SpW(12) = (W_)new_aps;
|
|
| 1347 | - SpW(11) = (W_)False_closure; // True <=> an exception
|
|
| 1348 | - SpW(10) = (W_)&stg_ap_ppv_info;
|
|
| 1349 | - SpW(9) = (W_)arg5_info_index;
|
|
| 1347 | + Sp_subW(19);
|
|
| 1348 | + SpW(18) = (W_)obj;
|
|
| 1349 | + SpW(17) = (W_)&stg_apply_interp_info;
|
|
| 1350 | + SpW(16) = (W_)new_aps;
|
|
| 1351 | + SpW(15) = (W_)False_closure; // True <=> an exception
|
|
| 1352 | + SpW(14) = (W_)&stg_ap_ppv_info;
|
|
| 1353 | + SpW(13) = (W_)arg7_info_index;
|
|
| 1354 | + SpW(12) = (W_)&stg_ap_n_info;
|
|
| 1355 | + SpW(11) = (W_)BCO_LIT(arg5_info_mod_id);
|
|
| 1356 | + SpW(10) = (W_)&stg_ap_n_info;
|
|
| 1357 | + SpW(9) = (W_)BCO_LIT(arg3_info_mod);
|
|
| 1350 | 1358 | SpW(8) = (W_)&stg_ap_n_info;
|
| 1351 | - SpW(7) = (W_)BCO_LIT(arg3_info_mod);
|
|
| 1359 | + SpW(7) = (W_)arg6_tick_index;
|
|
| 1352 | 1360 | SpW(6) = (W_)&stg_ap_n_info;
|
| 1353 | - SpW(5) = (W_)arg4_tick_index;
|
|
| 1361 | + SpW(5) = (W_)BCO_LIT(arg4_tick_mod_id);
|
|
| 1354 | 1362 | SpW(4) = (W_)&stg_ap_n_info;
|
| 1355 | 1363 | SpW(3) = (W_)BCO_LIT(arg2_tick_mod);
|
| 1356 | 1364 | SpW(2) = (W_)&stg_ap_n_info;
|
| 1 | +{-# LANGUAGE MagicHash #-}
|
|
| 2 | + |
|
| 3 | +module T25976 where
|
|
| 4 | + |
|
| 5 | +import GHC.PrimOps (tagToEnum#)
|
|
| 6 | + |
|
| 7 | +-- Spoiler - it's all dead code since tagToEnum 3# is undefined
|
|
| 8 | +main = case (tagToEnum# 4# :: Bool) of
|
|
| 9 | + True -> print "Dead Code"
|
|
| 10 | + False -> print "Dead Code" |
| ... | ... | @@ -541,3 +541,5 @@ test('T25883', normal, compile_grep_core, ['']) |
| 541 | 541 | test('T25883b', normal, compile_grep_core, [''])
|
| 542 | 542 | test('T25883c', normal, compile_grep_core, [''])
|
| 543 | 543 | test('T25883d', [extra_files(['T25883d_import.hs'])], multimod_compile_filter, ['T25883d', '-O -ddump-simpl -dno-typeable-binds -dsuppress-all -dsuppress-uniques', r'grep -e "y ="'])
|
| 544 | + |
|
| 545 | +test('T25976', [grep_errmsg('Dead Code')], compile, ['-O -ddump-simpl -dsuppress-uniques -dno-typeable-binds']) |