X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fghci%2FByteCodeGen.lhs;h=947382eacf9adaf1e7a22f86b609155c61d0c0f4;hb=10f0ba21b50896514e5ac885f0e9f0bc7e2c4876;hp=8a4b5e29a959368906745aa90192d046e4745e65;hpb=b0046dd679244886fdc62e5cc2a73128d2e018bb;p=ghc-hetmet.git diff --git a/compiler/ghci/ByteCodeGen.lhs b/compiler/ghci/ByteCodeGen.lhs index 8a4b5e2..947382e 100644 --- a/compiler/ghci/ByteCodeGen.lhs +++ b/compiler/ghci/ByteCodeGen.lhs @@ -438,7 +438,7 @@ schemeE d s p (AnnLet binds (_,body)) compile_bind d' fvs x rhs size arity off = do bco <- schemeR fvs (x,rhs) - build_thunk (fromIntegral d') fvs size bco off arity + build_thunk d' fvs size bco off arity compile_binds = [ compile_bind d' fvs x rhs size arity n @@ -1034,7 +1034,7 @@ generateCCall d0 s p (CCallSpec target cconv _) fn args_r_to_l stdcall_adj_target #ifdef mingw32_TARGET_OS | StdCallConv <- cconv - = let size = a_reps_sizeW * wORD_SIZE in + = let size = fromIntegral a_reps_sizeW * wORD_SIZE in mkFastString (unpackFS target ++ '@':show size) #endif | otherwise @@ -1203,7 +1203,7 @@ pushAtom d p (AnnVar v) = return (unitOL (PUSH_PRIMOP primop), 1) | Just d_v <- lookupBCEnv_maybe p v -- v is a local variable - = let l = d - fromIntegral d_v + sz - 2 + = let l = d - d_v + sz - 2 in return (toOL (genericReplicate sz (PUSH_L l)), sz) -- d - d_v the number of words between the TOS -- and the 1st slot of the object @@ -1534,7 +1534,10 @@ recordItblMallocBc a getLabelBc :: BcM Word16 getLabelBc - = BcM $ \st -> return (st{nextlabel = 1 + nextlabel st}, nextlabel st) + = BcM $ \st -> do let nl = nextlabel st + when (nl == maxBound) $ + panic "getLabelBc: Ran out of labels" + return (st{nextlabel = nl + 1}, nl) getLabelsBc :: Word16 -> BcM [Word16] getLabelsBc n