-testCFG = buildCFG . codeInstructions
-
-buildCFG :: [Instruction] -> MapBB
-buildCFG xs = buildCFG' M.empty xs' xs'
- where
- xs' :: [OffIns]
- xs' = markBackwardTargets $ calculateInstructionOffset xs
-
--- get already calculated jmp-targets and mark the predecessor of the
--- target-instruction as "FallThrough". we just care about backwards
--- jumps here (forward jumps are handled in buildCFG')
-markBackwardTargets :: [OffIns] -> [OffIns]
-markBackwardTargets [] = []
-markBackwardTargets (x:[]) = [x]
-markBackwardTargets insns@(x@(x_off,x_bbend,x_ins):y@(y_off,_,_):xs) =
- x_new:markBackwardTargets (y:xs)
- where
- x_new = case x_bbend of
- Just _ -> x -- already marked, don't change
- Nothing -> if isTarget then checkX y_off else x
- checkX w16 = case x_bbend of
- Nothing -> (x_off, Just $ FallThrough w16, x_ins) -- mark previous insn
- _ -> error "basicblock: something is wrong"
-
- -- look through all remaining insns in the stream if there is a jmp to `y'
- isTarget = case find cmpOffset insns of Just _ -> True; Nothing -> False
- cmpOffset (_,Just (OneTarget w16),_) = w16 == y_off
- cmpOffset (_,Just (TwoTarget _ w16),_) = w16 == y_off
- cmpOffset _ = False
-
-
-buildCFG' :: MapBB -> [OffIns] -> [OffIns] -> MapBB
-buildCFG' hmap [] _ = hmap
-buildCFG' hmap ((off, entry, _):xs) insns = buildCFG' (insertlist entryi hmap) xs insns