-main = do
- args <- getArgs
- case args of
- [clspath] -> parseFile clspath "fib" -- TODO
- _ -> error "Synopsis: dump-class File.class"
-
-
-parseFile :: String -> B.ByteString -> IO ()
-parseFile clspath method = do
- --clsFile <- decodeFile clspath
- --putStrLn $ showListIx $ M.assocs $ constsPool (clsFile :: Class Pointers)
- cls <- parseClassFile clspath
- --dumpClass cls
- let mainmethod = lookupMethod method cls -- "main|([Ljava/lang/String;)V" cf
- let hmap = testCFG mainmethod
- putStr "BlockIDs: "
- let keys = fst $ unzip $ H.toList hmap
- mapM_ (putStr . (flip (++)) ", " . show) keys
- putStrLn "\n\nBasicBlocks:"
- printMapBB keys hmap
-
-printMapBB :: [BlockID] -> MapBB -> IO ()
-printMapBB [] _ = return ()
-printMapBB (i:is) hmap = case H.lookup i hmap of
- Just bb -> do
- putStrLn $ "Block " ++ (show i)
- mapM_ putStrLn (map ((++) "\t" . show) $ code bb)
- case successor bb of
- Return -> putStrLn ""
- OneTarget t1 -> putStrLn $ "Sucessor: " ++ (show t1) ++ "\n"
- TwoTarget t1 t2 -> putStrLn $ "Sucessor: " ++ (show t1) ++ ", " ++ (show t2) ++ "\n"
- printMapBB is hmap
- Nothing -> error $ "BlockID " ++ show i ++ " not found."
-
-test_01 = parseFile "./tests/Fib.class" "fib"
-test_02 = parseFile "./tests/While.class" "f"
-test_03 = parseFile "./tests/While.class" "g"
-
-
-testCFG :: Maybe (Method Resolved) -> MapBB
-testCFG (Just m) = case attrByName m "Code" of
- Nothing -> error "no code"
- Just bytecode -> let code = decodeMethod bytecode
- instructions = codeInstructions code
- in buildCFG instructions
-testCFG _ = error "no method to build cfg"
-
+#ifdef DBG_BB
+printMapBB :: MapBB -> IO ()
+printMapBB hmap = do
+ putStr "BlockIDs: "
+ let keys = M.keys hmap
+ mapM_ (putStr . (flip (++)) ", " . show) keys
+ putStrLn "\n\nBasicBlocks:"
+ printMapBB' keys hmap
+ where
+ printMapBB' :: [BlockID] -> MapBB -> IO ()
+ printMapBB' [] _ = return ()
+ printMapBB' (i:is) hmap' = case M.lookup i hmap' of
+ Just bb -> do
+ putStrLn $ "Block " ++ (show i)
+ mapM_ putStrLn (map ((++) "\t" . show) $ code bb)
+ case successor bb of
+ Return -> putStrLn ""
+ FallThrough t1 -> putStrLn $ "Sucessor: " ++ (show t1) ++ "\n"
+ OneTarget t1 -> putStrLn $ "Sucessor: " ++ (show t1) ++ "\n"
+ TwoTarget t1 t2 -> putStrLn $ "Sucessor: " ++ (show t1) ++ ", " ++ (show t2) ++ "\n"
+ printMapBB' is hmap
+ Nothing -> error $ "BlockID " ++ show i ++ " not found."
+#endif
+
+#if 0
+#ifdef DBG_BB
+testInstance :: String -> B.ByteString -> MethodSignature -> IO ()
+testInstance cf method sig = do
+ cls <- parseClassFile cf
+ hmap <- parseMethod cls method sig
+ printMapBB hmap
+#endif
+
+#ifdef DBG_BB
+test_main :: IO ()
+test_main = do
+ test_01
+ test_02
+ test_03
+ test_04
+
+test_01, test_02, test_03, test_04 :: IO ()
+test_01 = testInstance "./tests/Fib.class" "fib"
+test_02 = testInstance "./tests/While.class" "f"
+test_03 = testInstance "./tests/While.class" "g"
+test_04 = testInstance "./tests/Fac.class" "fac"
+#endif
+#endif
+
+
+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 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 msig = methodSignature $ classMethods cls !! 1
+ printfBb "BB: analysing \"%s\"\n" $ toString (methodname `B.append` ": " `B.append` encode msig)
+#ifdef DBG_BB
+ printMapBB mapbb
+#endif
+ -- small example how to get information about
+ -- exceptions of a method
+ -- TODO: remove ;-)
+ let (Just m) = lookupMethodSig methodname sig cls
+ case attrByName m "Code" of
+ Nothing ->
+ printfBb "exception: no handler for this method\n"
+ Just exceptionstream ->
+ printfBb "exception: \"%s\"\n" (show $ codeExceptions $ decodeMethod exceptionstream)
+ return $ RawMethod mapbb locals stacks argscount
+
+
+testCFG :: Code -> MapBB
+testCFG = buildCFG . codeInstructions