-#endif
-
-
-parseMethod :: Class Resolved -> B.ByteString -> IO (Maybe MapBB)
-parseMethod cls method = do
- let maybe_bb = testCFG $ lookupMethod method cls
-#ifdef DEBUG
- putStr "BB: analysing: "
- let msig = methodSignature $ (classMethods cls) !! 1
- putStrLn $ toString (method `B.append` ": " `B.append` (encode msig))
- printMapBB maybe_bb
-#endif
-#ifdef DEBUG
- -- small example how to get information about
- -- exceptions of a method
- -- TODO: remove ;-)
- let (Just m) = lookupMethod method cls
- case attrByName m "Code" of
- Nothing -> printf "exception: no handler for this method\n"
- Just exceptionstream -> printf "exception: \"%s\"\n" (show $ codeExceptions $ decodeMethod exceptionstream)
-#endif
- return maybe_bb
-
-
-testCFG :: Maybe (Method Resolved) -> Maybe MapBB
-testCFG (Just m) = case attrByName m "Code" of
- Nothing -> Nothing
- Just bytecode -> Just $ buildCFG $ codeInstructions $ decodeMethod bytecode
-testCFG _ = Nothing
-
-
-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 = if isTarget then checkX y_off else x
- checkX w16 = case x_bbend of
- Just _ -> x -- already marked, don't change
- Nothing -> ((x_off, Just $ FallThrough w16), x_ins) -- mark previous insn
-
- -- 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
+-}
+
+
+parseMethod :: Class Direct -> B.ByteString -> MethodSignature -> IO RawMethod
+parseMethod cls methodname sig = do
+ let method = fromMaybe
+ (error $ "method " ++ (show . toString) methodname ++ " not found")
+ (lookupMethodSig methodname sig cls)
+ let codeseg = fromMaybe
+ (error $ "codeseg " ++ (show . toString) methodname ++ " not found")
+ (attrByName method "Code")
+ let decoded = decodeMethod codeseg
+ let mapbb = testCFG decoded
+ let locals = fromIntegral (codeMaxLocals decoded)
+ let stacks = fromIntegral (codeStackSize decoded)
+ let codelen = fromIntegral (codeLength decoded)
+ let methoddirect = methodInfoToMethod (MethodInfo methodname "" sig) cls
+ let isStatic = methodIsStatic methoddirect
+ let nametype = methodNameType methoddirect
+ let argscount = methodGetArgsCount nametype + (if isStatic then 0 else 1)
+
+ let exceptionMap :: ExceptionMap
+ exceptionMap = foldl f M.empty $ codeExceptions decoded
+ where
+ f emap ce =
+ if M.member key emap
+ then M.adjust (value:) key emap
+ else M.insert key [value] emap
+ where
+ key = (&&&) eStartPC eEndPC ce
+ value = (&&&) g eHandlerPC ce
+ where
+ g ce' = case eCatchType ce' of
+ 0 -> B.empty
+ x -> buildClassID cls x
+
+ let msig = methodSignature method
+ printfBb $ printf "BB: analysing \"%s\"\n" $ toString (methodname `B.append` ": " `B.append` encode msig)
+ printMapBB mapbb
+ return $ RawMethod mapbb exceptionMap locals stacks argscount codelen
+
+
+testCFG :: Code -> MapBB
+testCFG c = buildCFG (codeInstructions c) (codeExceptions c)