diff options
Diffstat (limited to 'compiler/ghci/ByteCodeLink.hs')
| -rw-r--r-- | compiler/ghci/ByteCodeLink.hs | 43 |
1 files changed, 22 insertions, 21 deletions
diff --git a/compiler/ghci/ByteCodeLink.hs b/compiler/ghci/ByteCodeLink.hs index aa92ecc610..74f490b8fd 100644 --- a/compiler/ghci/ByteCodeLink.hs +++ b/compiler/ghci/ByteCodeLink.hs @@ -22,6 +22,7 @@ module ByteCodeLink ( import GHCi.RemoteTypes import GHCi.ResolvedBCO import GHCi.InfoTable +import GHCi.BreakArray import SizedSeq import GHCi @@ -60,15 +61,16 @@ extendClosureEnv cl_env pairs -} linkBCO - :: HscEnv -> ItblEnv -> ClosureEnv -> NameEnv Int -> UnlinkedBCO + :: HscEnv -> ItblEnv -> ClosureEnv -> NameEnv Int -> RemoteRef BreakArray + -> UnlinkedBCO -> IO ResolvedBCO -linkBCO hsc_env ie ce bco_ix +linkBCO hsc_env ie ce bco_ix breakarray (UnlinkedBCO _ arity insns bitmap lits0 ptrs0) = do lits <- mapM (lookupLiteral hsc_env ie) (ssElts lits0) - ptrs <- mapM (resolvePtr hsc_env ie ce bco_ix) (ssElts ptrs0) + ptrs <- mapM (resolvePtr hsc_env ie ce bco_ix breakarray) (ssElts ptrs0) return (ResolvedBCO arity insns bitmap - (listArray (0, fromIntegral (sizeSS lits0)-1) lits) - (addListToSS emptySS ptrs)) + (listArray (0, fromIntegral (sizeSS lits0)-1) lits) + (addListToSS emptySS ptrs)) lookupLiteral :: HscEnv -> ItblEnv -> BCONPtr -> IO Word lookupLiteral _ _ (BCONPtrWord lit) = return lit @@ -79,7 +81,7 @@ lookupLiteral hsc_env ie (BCONPtrItbl nm) = do Ptr a# <- lookupIE hsc_env ie nm return (W# (int2Word# (addr2Int# a#))) lookupLiteral hsc_env _ (BCONPtrStr bs) = do - fromIntegral . ptrToWordPtr <$> mallocData hsc_env bs + fromIntegral . ptrToWordPtr . fromRemotePtr <$> mallocData hsc_env bs lookupStaticPtr :: HscEnv -> FastString -> IO (Ptr ()) lookupStaticPtr hsc_env addr_of_label_string = do @@ -89,26 +91,26 @@ lookupStaticPtr hsc_env addr_of_label_string = do Nothing -> linkFail "ByteCodeLink: can't find label" (unpackFS addr_of_label_string) -lookupIE :: HscEnv -> ItblEnv -> Name -> IO (Ptr a) +lookupIE :: HscEnv -> ItblEnv -> Name -> IO (Ptr ()) lookupIE hsc_env ie con_nm = case lookupNameEnv ie con_nm of - Just (_, ItblPtr a) -> return (castPtr (conInfoPtr a)) + Just (_, ItblPtr a) -> return (conInfoPtr (fromRemotePtr (castRemotePtr a))) Nothing -> do -- try looking up in the object files. let sym_to_find1 = nameToCLabel con_nm "con_info" m <- lookupSymbol hsc_env sym_to_find1 case m of - Just addr -> return (castPtr addr) + Just addr -> return addr Nothing -> do -- perhaps a nullary constructor? let sym_to_find2 = nameToCLabel con_nm "static_info" n <- lookupSymbol hsc_env sym_to_find2 case n of - Just addr -> return (castPtr addr) + Just addr -> return addr Nothing -> linkFail "ByteCodeLink.lookupIE" (unpackFS sym_to_find1 ++ " or " ++ unpackFS sym_to_find2) -lookupPrimOp :: HscEnv -> PrimOp -> IO RemotePtr +lookupPrimOp :: HscEnv -> PrimOp -> IO (RemotePtr ()) lookupPrimOp hsc_env primop = do let sym_to_find = primopToCLabel primop "closure" m <- lookupSymbol hsc_env (mkFastString sym_to_find) @@ -117,13 +119,14 @@ lookupPrimOp hsc_env primop = do Nothing -> linkFail "ByteCodeLink.lookupCE(primop)" sym_to_find resolvePtr - :: HscEnv -> ItblEnv -> ClosureEnv -> NameEnv Int -> BCOPtr + :: HscEnv -> ItblEnv -> ClosureEnv -> NameEnv Int -> RemoteRef BreakArray + -> BCOPtr -> IO ResolvedBCOPtr -resolvePtr hsc_env _ie ce bco_ix (BCOPtrName nm) +resolvePtr hsc_env _ie ce bco_ix _ (BCOPtrName nm) | Just ix <- lookupNameEnv bco_ix nm = return (ResolvedBCORef ix) -- ref to another BCO in this group | Just (_, rhv) <- lookupNameEnv ce nm = - return (ResolvedBCOPtr (unsafeForeignHValueToHValueRef rhv)) + return (ResolvedBCOPtr (unsafeForeignRefToRemoteRef rhv)) | otherwise = ASSERT2(isExternalName nm, ppr nm) do let sym_to_find = nameToCLabel nm "closure" @@ -131,14 +134,12 @@ resolvePtr hsc_env _ie ce bco_ix (BCOPtrName nm) case m of Just p -> return (ResolvedBCOStaticPtr (toRemotePtr p)) Nothing -> linkFail "ByteCodeLink.lookupCE" (unpackFS sym_to_find) -resolvePtr hsc_env _ _ _ (BCOPtrPrimOp op) = +resolvePtr hsc_env _ _ _ _ (BCOPtrPrimOp op) = ResolvedBCOStaticPtr <$> lookupPrimOp hsc_env op -resolvePtr hsc_env ie ce bco_ix (BCOPtrBCO bco) = - ResolvedBCOPtrBCO <$> linkBCO hsc_env ie ce bco_ix bco -resolvePtr _ _ _ _ (BCOPtrBreakInfo break_info) = - return (ResolvedBCOPtrLocal (unsafeCoerce# break_info)) -resolvePtr _ _ _ _ (BCOPtrArray break_array) = - return (ResolvedBCOPtrLocal (unsafeCoerce# break_array)) +resolvePtr hsc_env ie ce bco_ix breakarray (BCOPtrBCO bco) = + ResolvedBCOPtrBCO <$> linkBCO hsc_env ie ce bco_ix breakarray bco +resolvePtr _ _ _ _ breakarray BCOPtrBreakArray = + return (ResolvedBCOPtrBreakArray breakarray) linkFail :: String -> String -> IO a linkFail who what |