X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fghci%2FByteCodeLink.lhs;h=521c162db4cf15a187bea773f78f6c23d0a7614b;hb=c1681a73fa4ca4cf8758264ae387ac09a9e900d8;hp=9988325dd3317dbdedb72766878ab542bc3e64b0;hpb=b067bdc33ce1a0bb01957b0bcfbb1c516dba53a4;p=ghc-hetmet.git diff --git a/compiler/ghci/ByteCodeLink.lhs b/compiler/ghci/ByteCodeLink.lhs index 9988325..521c162 100644 --- a/compiler/ghci/ByteCodeLink.lhs +++ b/compiler/ghci/ByteCodeLink.lhs @@ -9,7 +9,7 @@ ByteCodeLink: Bytecode assembler and linker module ByteCodeLink ( HValue, ClosureEnv, emptyClosureEnv, extendClosureEnv, - linkBCO, lookupStaticPtr + linkBCO, lookupStaticPtr, lookupName ,lookupIE ) where @@ -27,7 +27,6 @@ import Module import PackageConfig import FastString import Panic -import Breakpoints #ifdef DEBUG import Outputable @@ -47,7 +46,7 @@ import GHC.Exts import GHC.Arr ( Array(..) ) import GHC.IOBase ( IO(..) ) import GHC.Ptr ( Ptr(..), castPtr ) -import GHC.Base ( writeArray#, RealWorld, Int(..) ) +import GHC.Base ( writeArray#, RealWorld, Int(..), Word# ) \end{code} @@ -59,7 +58,7 @@ import GHC.Base ( writeArray#, RealWorld, Int(..) ) \begin{code} type ClosureEnv = NameEnv (Name, HValue) -newtype HValue = HValue (forall a . a) +newtype HValue = HValue Any emptyClosureEnv = emptyNameEnv @@ -143,6 +142,10 @@ mkPtrsArray ie ce n_ptrs ptrs = do fill (BCOPtrBCO ul_bco) i = do BCO bco# <- linkBCO' ie ce ul_bco writeArrayBCO marr i bco# + fill (BCOPtrBreakInfo brkInfo) i = + unsafeWrite marr i (unsafeCoerce# brkInfo) + fill (BCOPtrArray brkArray) i = + unsafeWrite marr i (unsafeCoerce# brkArray) zipWithM fill ptrs [0..] unsafeFreeze marr @@ -163,10 +166,16 @@ writeArrayBCO (IOArray (STArray _ _ marr#)) (I# i#) bco# = IO $ \s# -> case (unsafeCoerce# writeArray#) marr# i# bco# s# of { s# -> (# s#, () #) } +{- +writeArrayMBA :: IOArray Int a -> Int -> MutableByteArray# a -> IO () +writeArrayMBA (IOArray (STArray _ _ marr#)) (I# i#) mba# = IO $ \s# -> + case (unsafeCoerce# writeArray#) marr# i# bco# s# of { s# -> + (# s#, () #) } +-} + data BCO = BCO BCO# -newBCO :: ByteArray# -> ByteArray# -> Array# a - -> Int# -> ByteArray# -> IO BCO +newBCO :: ByteArray# -> ByteArray# -> Array# a -> Int# -> ByteArray# -> IO BCO newBCO instrs lits ptrs arity bitmap = IO $ \s -> case newBCO# instrs lits ptrs arity bitmap s of (# s1, bco #) -> (# s1, BCO bco #) @@ -201,8 +210,6 @@ lookupName :: ClosureEnv -> Name -> IO HValue 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"