diff options
Diffstat (limited to 'compiler/GHC/StgToByteCode.hs')
| -rw-r--r-- | compiler/GHC/StgToByteCode.hs | 22 |
1 files changed, 13 insertions, 9 deletions
diff --git a/compiler/GHC/StgToByteCode.hs b/compiler/GHC/StgToByteCode.hs index e14de72eb5..b2743ece43 100644 --- a/compiler/GHC/StgToByteCode.hs +++ b/compiler/GHC/StgToByteCode.hs @@ -117,7 +117,7 @@ byteCodeGen hsc_env this_mod binds tycs mb_modBreaks StgTopStringLit b str -> [Left (b, str)] flattenBind (StgNonRec b e) = [(b,e)] flattenBind (StgRec bs) = bs - stringPtrs <- allocateTopStrings hsc_env strings + stringPtrs <- allocateTopStrings interp strings us <- mkSplitUniqSupply 'y' (BcM_State{..}, proto_bcos) <- @@ -134,7 +134,7 @@ byteCodeGen hsc_env this_mod binds tycs mb_modBreaks "Proto-BCOs" FormatByteCode (vcat (intersperse (char ' ') (map ppr proto_bcos))) - cbc <- assembleBCOs hsc_env proto_bcos tycs (map snd stringPtrs) + cbc <- assembleBCOs interp profile proto_bcos tycs (map snd stringPtrs) (case modBreaks of Nothing -> Nothing Just mb -> Just mb{ modBreaks_breakInfo = breakInfo }) @@ -151,14 +151,16 @@ byteCodeGen hsc_env this_mod binds tycs mb_modBreaks where dflags = hsc_dflags hsc_env logger = hsc_logger hsc_env + interp = hscInterp hsc_env + profile = targetProfile dflags allocateTopStrings - :: HscEnv + :: Interp -> [(Id, ByteString)] -> IO [(Var, RemotePtr ())] -allocateTopStrings hsc_env topStrings = do +allocateTopStrings interp topStrings = do let !(bndrs, strings) = unzip topStrings - ptrs <- iservCmd hsc_env $ MallocStrings strings + ptrs <- interpCmd interp $ MallocStrings strings return $ zip bndrs ptrs {- @@ -169,7 +171,7 @@ literals: 1. Top-level string literal bindings are separated from the rest of the module. -2. The strings are allocated via iservCmd, in allocateTopStrings +2. The strings are allocated via interpCmd, in allocateTopStrings 3. The mapping from binders to allocated strings (topStrings) are maintained in BcM and used when generating code for variable references. @@ -207,9 +209,11 @@ stgExprToBCOs hsc_env this_mod expr_ty expr dumpIfSet_dyn logger dflags Opt_D_dump_BCOs "Proto-BCOs" FormatByteCode (ppr proto_bco) - assembleOneBCO hsc_env proto_bco + assembleOneBCO interp profile proto_bco where dflags = hsc_dflags hsc_env logger = hsc_logger hsc_env + profile = targetProfile dflags + interp = hscInterp hsc_env -- we need an otherwise unused Id for bytecode generation dummy_id = mkSysLocal (fsLit "BCO_toplevel") (mkPseudoUniqueE 0) @@ -1601,8 +1605,8 @@ generateCCall d0 s p (CCallSpec target cconv safety) result_ty args_r_to_l let ffires = primRepToFFIType platform r_rep ffiargs = map (primRepToFFIType platform) a_reps - hsc_env <- getHscEnv - token <- ioToBc $ iservCmd hsc_env (PrepFFI conv ffiargs ffires) + interp <- hscInterp <$> getHscEnv + token <- ioToBc $ interpCmd interp (PrepFFI conv ffiargs ffires) recordFFIBc token let |