- newoffset :: Instruction -> Int -> Offset
- newoffset x off = (off + (fromIntegral $ B.length $ encodeInstructions [x]), Nothing)
-
- addW16Signed :: Int -> Word16 -> Int
- addW16Signed i w16 = i + (fromIntegral s16)
- where s16 = (fromIntegral w16) :: Int16
-
- cio' :: Offset -> [Instruction] -> [OffIns]
- cio' _ [] = []
- -- TODO(bernhard): add more instruction with offset (IF_ACMP, JSR, ...)
- cio' (off,_) (x:xs) = case x of
- IF _ w16 -> twotargets w16
- IF_ICMP _ w16 -> twotargets w16
- IF_ACMP _ w16 -> twotargets w16
- GOTO w16 -> onetarget w16
- IRETURN -> notarget
- ARETURN -> notarget
- RETURN -> notarget
- _ -> ((off, Nothing), x):next
- where
- notarget = ((off, Just Return), x):next
- onetarget w16 = ((off, Just $ OneTarget $ (off `addW16Signed` w16)), x):next
- twotargets w16 = ((off, Just $ TwoTarget (off + 3) (off `addW16Signed` w16)), x):next
- next = cio' (newoffset x off) xs
+ addW16Signed :: Int -> Word16 -> Int
+ addW16Signed i w16 = i + fromIntegral s16
+ where s16 = fromIntegral w16 :: Int16
+
+ cio' :: OffIns -> [Instruction] -> AnalyseState
+ cio' _ [] = return $ []
+ cio' (off,_,_) (x:xs) = case x of
+ IF _ w16 -> twotargets w16
+ IF_ICMP _ w16 -> twotargets w16
+ IF_ACMP _ w16 -> twotargets w16
+ IFNONNULL w16 -> twotargets w16
+ IFNULL w16 -> twotargets w16
+ GOTO w16 -> onetarget w16
+ IRETURN -> notarget
+ ARETURN -> notarget
+ RETURN -> notarget
+ _ -> normalins
+ where
+ normalins = do
+ tailinsns <- next -- eval remaining instructions
+ isNextInsATarget <- (elem newoffset) <$> get
+ let bbtyp = if isNextInsATarget
+ then Just $ FallThrough newoffset
+ else Nothing
+ return $ (off, bbtyp, x):tailinsns
+ notarget = ((off, Just Return, x):) <$> next
+ onetarget w16 = do
+ let jump = off `addW16Signed` w16
+ modify (jump:)
+ ((off, Just $ OneTarget jump, x):) <$> next
+ twotargets w16 = do
+ let nojump = off + 3
+ modify (nojump:)
+ let jump = off `addW16Signed` w16
+ modify (jump:)
+ ((off, Just $ TwoTarget nojump jump, x):) <$> next
+ next = cio' nextins xs
+ nextins = (newoffset, Nothing, NOP)
+ newoffset = off + insnLength x
+
+-- TODO(bernhard): does GHC memomize results? i.e. does it calculate the size
+-- of `NOP' only once?
+insnLength :: Num a => Instruction -> a
+insnLength = fromIntegral . B.length . encodeInstructions . (:[])