X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fghci%2FByteCodeGen.lhs;h=e0920fc2f1b3cb9c130329d96301863a72a3279c;hb=ada3dd2248d0308819fa9d3290f79a2a0d372db9;hp=7d6bc234f7057647fed86568c6830362fc46d89a;hpb=76349636abcb764e8ed3b9ae548730ad2d85abb2;p=ghc-hetmet.git diff --git a/compiler/ghci/ByteCodeGen.lhs b/compiler/ghci/ByteCodeGen.lhs index 7d6bc23..e0920fc 100644 --- a/compiler/ghci/ByteCodeGen.lhs +++ b/compiler/ghci/ByteCodeGen.lhs @@ -298,7 +298,7 @@ schemeER_wrk d p rhs | Just (tickInfo, (_annot, newRhs)) <- isTickedExp' rhs = do code <- schemeE d 0 p newRhs arr <- getBreakArray - let idOffSets = getVarOffSets (fromIntegral d) p tickInfo + let idOffSets = getVarOffSets d p tickInfo let tickNumber = tickInfo_number tickInfo let breakInfo = BreakInfo { breakInfo_module = tickInfo_module tickInfo @@ -923,7 +923,7 @@ generateCCall :: Word16 -> Sequel -- stack and sequel depths -> [AnnExpr' Id VarSet] -- args (atoms) -> BcM BCInstrList -generateCCall d0 s p (CCallSpec target cconv _) fn args_r_to_l +generateCCall d0 s p (CCallSpec target cconv safety) fn args_r_to_l = let -- useful constants addr_sizeW :: Word16 @@ -1092,7 +1092,8 @@ generateCCall d0 s p (CCallSpec target cconv _) fn args_r_to_l recordItblMallocBc (ItblPtr (castFunPtrToPtr addr_of_marshaller)) let -- do the call - do_call = unitOL (CCALL stk_offset (castFunPtrToPtr addr_of_marshaller)) + do_call = unitOL (CCALL stk_offset (castFunPtrToPtr addr_of_marshaller) + (fromIntegral (fromEnum (playInterruptible safety)))) -- slide and return wrapup = mkSLIDE r_sizeW (d_after_r - r_sizeW - s) `snocOL` RETURN_UBX (primRepToCgRep r_rep) @@ -1564,9 +1565,9 @@ getBreakArray = BcM $ \st -> return (st, breakArray st) newUnique :: BcM Unique newUnique = BcM $ - \st -> case splitUniqSupply (uniqSupply st) of - (us1, us2) -> let newState = st { uniqSupply = us2 } - in return (newState, uniqFromSupply us1) + \st -> case takeUniqFromSupply (uniqSupply st) of + (uniq, us) -> let newState = st { uniqSupply = us } + in return (newState, uniq) newId :: Type -> BcM Id newId ty = do