X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2Fghci%2FByteCodeAsm.lhs;h=6f6e51d0f5ee0c5ca9fa9feb2184923e7e0e4c04;hp=030ef896e607ae2b552418ae3c4e8442ee60b187;hb=83d563cb9ede0ba792836e529b1e2929db926355;hpb=a2a67cd520b9841114d69a87a423dabcb3b4368e diff --git a/compiler/ghci/ByteCodeAsm.lhs b/compiler/ghci/ByteCodeAsm.lhs index 030ef89..6f6e51d 100644 --- a/compiler/ghci/ByteCodeAsm.lhs +++ b/compiler/ghci/ByteCodeAsm.lhs @@ -23,7 +23,6 @@ import ByteCodeItbls import Name import NameSet -import FiniteMap import Literal import TyCon import PrimOp @@ -42,6 +41,8 @@ import Data.Array.ST ( castSTUArray ) import Foreign import Data.Char ( ord ) import Data.List +import Data.Map (Map) +import qualified Data.Map as Map import GHC.Base ( ByteArray#, MutableByteArray#, RealWorld ) @@ -128,19 +129,19 @@ assembleBCO (ProtoBCO nm instrs bitmap bsize arity _origin _malloced) | wORD_SIZE_IN_BITS == 64 = 4 | wORD_SIZE_IN_BITS == 32 = 2 | otherwise = error "wORD_SIZE_IN_BITS not 32 or 64?" - label_env = mkLabelEnv emptyFM lableInitialOffset instrs + label_env = mkLabelEnv Map.empty lableInitialOffset instrs - mkLabelEnv :: FiniteMap Word16 Word -> Word -> [BCInstr] - -> FiniteMap Word16 Word + mkLabelEnv :: Map Word16 Word -> Word -> [BCInstr] + -> Map Word16 Word mkLabelEnv env _ [] = env mkLabelEnv env i_offset (i:is) = let new_env - = case i of LABEL n -> addToFM env n i_offset ; _ -> env + = case i of LABEL n -> Map.insert n i_offset env ; _ -> env in mkLabelEnv new_env (i_offset + instrSize16s i) is findLabel :: Word16 -> Word findLabel lab - = case lookupFM label_env lab of + = case Map.lookup lab label_env of Just bco_offset -> bco_offset Nothing -> pprPanic "assembleBCO.findLabel" (ppr lab) in @@ -288,6 +289,10 @@ mkBits findLabel st proto_insns instr2Large st2 bci_TESTLT_I np (findLabel l) TESTEQ_I i l -> do (np, st2) <- int st i instr2Large st2 bci_TESTEQ_I np (findLabel l) + TESTLT_W w l -> do (np, st2) <- word st w + instr2Large st2 bci_TESTLT_W np (findLabel l) + TESTEQ_W w l -> do (np, st2) <- word st w + instr2Large st2 bci_TESTEQ_W np (findLabel l) TESTLT_F f l -> do (np, st2) <- float st f instr2Large st2 bci_TESTLT_F np (findLabel l) TESTEQ_F f l -> do (np, st2) <- float st f @@ -304,8 +309,8 @@ mkBits findLabel st proto_insns ENTER -> instr1 st bci_ENTER RETURN -> instr1 st bci_RETURN RETURN_UBX rep -> instr1 st (return_ubx rep) - CCALL off m_addr -> do (np, st2) <- addr st m_addr - instr3 st2 bci_CCALL off np + CCALL off m_addr int -> do (np, st2) <- addr st m_addr + instr4 st2 bci_CCALL off np int BRK_FUN array index info -> do (p1, st2) <- ptr st (BCOPtrArray array) (p2, st3) <- ptr st2 (BCOPtrBreakInfo info) @@ -362,6 +367,11 @@ mkBits findLabel st proto_insns st_l1 <- addListToSS st_l0 (map BCONPtrWord ws) return (sizeSS16 st_l0, (st_i0,st_l1,st_p0)) + word (st_i0,st_l0,st_p0) w + = do let ws = [w] + st_l1 <- addListToSS st_l0 (map BCONPtrWord ws) + return (sizeSS16 st_l0, (st_i0,st_l1,st_p0)) + int64 (st_i0,st_l0,st_p0) i = do let ws = mkLitI64 i st_l1 <- addListToSS st_l0 (map BCONPtrWord ws) @@ -455,6 +465,8 @@ instrSize16s instr LABEL{} -> 0 -- !! TESTLT_I{} -> 3 TESTEQ_I{} -> 3 + TESTLT_W{} -> 3 + TESTEQ_W{} -> 3 TESTLT_F{} -> 3 TESTEQ_F{} -> 3 TESTLT_D{} -> 3 @@ -466,7 +478,7 @@ instrSize16s instr ENTER{} -> 1 RETURN{} -> 1 RETURN_UBX{} -> 1 - CCALL{} -> 3 + CCALL{} -> 4 SWIZZLE{} -> 3 BRK_FUN{} -> 4