The dynamic linker has been modified so that it won't panic if one of the breakpointJump functions fails to resolve.
Now, if the dynamic linker fails to find a HValue for a Name, before looking for a static symbol it will ask to
Breakpoints.lookupBogusBreakpointVal :: Name -> Maybe HValue
which returns an identity function for the Jump names or Nothing else.
A TH function might contain a call to a breakpoint function. So if it is compiled to bytecodes, the breakpoints will be desugared to 'jumps'. Whenever this code is spliced, the linker will fail to find the jumpfunctions unless there is a default.
import PackageConfig
import FastString
import Panic
import PackageConfig
import FastString
import Panic
#ifdef DEBUG
import Outputable
#ifdef DEBUG
import Outputable
lookupName ce nm
= case lookupNameEnv ce nm of
Just (_,aa) -> return aa
lookupName ce nm
= case lookupNameEnv ce nm of
Just (_,aa) -> return aa
+ Nothing | Just bk <- lookupBogusBreakpointVal nm
+ -> return bk
Nothing
-> ASSERT2(isExternalName nm, ppr nm)
do let sym_to_find = nameToCLabel nm "closure"
Nothing
-> ASSERT2(isExternalName nm, ppr nm)
do let sym_to_find = nameToCLabel nm "closure"
\r
module Breakpoints where\r
\r
\r
module Breakpoints where\r
\r
+#ifdef GHCI\r
+import {-#SOURCE#-} ByteCodeLink ( HValue ) \r
+#endif\r
+\r
import {-#SOURCE#-} HscTypes ( Session )\r
import {-#SOURCE#-} HscTypes ( Session )\r
+import Name\r
+import Var ( Id )\r
+import PrelNames\r
+\r
+import GHC.Exts ( unsafeCoerce# )\r
\r
data BkptHandler a = BkptHandler {\r
handleBreakpoint :: forall b. Session -> [(Id,HValue)] -> BkptLocation a -> String -> b -> IO b\r
\r
data BkptHandler a = BkptHandler {\r
handleBreakpoint :: forall b. Session -> [(Id,HValue)] -> BkptLocation a -> String -> b -> IO b\r
\r
noDbgSites :: SiteMap\r
noDbgSites = []\r
\r
noDbgSites :: SiteMap\r
noDbgSites = []\r
+\r
+-- | Returns the 'identity' jumps\r
+-- Used to deal with spliced code, where we don't want breakpoints\r
+#ifdef GHCI\r
+lookupBogusBreakpointVal :: Name -> Maybe HValue\r
+lookupBogusBreakpointVal name \r
+ | name == breakpointJumpName = Just$ unsafeCoerce# (\_ _ _ _ a->a)\r
+ | name == breakpointAutoJumpName = Just$ unsafeCoerce# (\_ _ _ _ a->a)\r
+ | name == breakpointCondJumpName = Just$ unsafeCoerce# (\_ _ _ _ _ a->a)\r
+ | otherwise = Nothing\r
+#else \r
+lookupBogusBreakpointVal _ = Nothing\r
+#endif //GHCI\r