Mate/BasicBlocks.hs

   1 {-# LANGUAGE OverloadedStrings #-}
   2 module Mate.BasicBlocks where
   3
   4 import Data.Binary
   5 import Data.Int
   6 import System.Environment
   7 import qualified Data.Map as M
   8 import qualified Data.ByteString.Lazy as B
   9
  10 import JVM.Common
  11 import JVM.ClassFile
  12 import JVM.Converter
  13 import JVM.Dump
  14 import JVM.Assembler
  15
  16 import Mate.Utilities
  17
  18 type Name       = String -- use "virtual register id" instead?
  19 data Type       = JInt | JFloat -- add more
  20 type Variable   = (Type,Name)
  21
  22 -- Represents a CFG node
  23 data BasicBlock = BasicBlock {
  24                      inputs  :: [Variable],
  25                      outputs :: [Variable],
  26                      code    :: [Instruction] }
  27
  28 -- Represents a Control-Flow-Graph as
  29 -- Adjacency list (add matrix representation if appropriate)
  30 type CFList     = [(BasicBlock, [BasicBlock])]
  31
  32
  33 main = do
  34   args <- getArgs
  35   case args of
  36     [clspath] -> parseFile clspath "fib" -- TODO
  37     _ -> error "Synopsis: dump-class File.class"
  38
  39
  40 parseFile :: String -> B.ByteString -> IO ()
  41 parseFile clspath method = do
  42                      --clsFile <- decodeFile clspath
  43                      --putStrLn $ showListIx $ M.assocs $ constsPool (clsFile :: Class Pointers)
  44                      cls <- parseClassFile clspath
  45                      --dumpClass cls
  46                      let mainmethod = lookupMethod method cls -- "main|([Ljava/lang/String;)V" cf
  47                      mapM_ putStrLn (testCFG mainmethod)
  48
  49 test_01 = parseFile "./tests/Fib.class" "fib"
  50 test_02 = parseFile "./tests/While.class" "f"
  51 test_03 = parseFile "./tests/While.class" "g"
  52
  53
  54 testCFG :: Maybe (Method Resolved) -> [String]
  55 testCFG (Just m) = case attrByName m "Code" of
  56                      Nothing       -> error "no code"
  57                      Just bytecode -> let code = decodeMethod bytecode
  58                                           instructions = codeInstructions code
  59                                       in buildCFG instructions
  60 testCFG _        = error "no method to build cfg"
  61
  62
  63 buildCFG :: [Instruction] -> [String]
  64 buildCFG xs = map (\(x,y) -> show x ++ ", " ++ show y) xs'
  65   where
  66   xs' = calculateInstructionOffset xs
  67
  68 type Offset = (Int, Maybe Int16) -- (offset in bytecode, offset to jump target)
  69
  70 calculateInstructionOffset :: [Instruction] -> [(Offset, Instruction)]
  71 calculateInstructionOffset = cio' (0, Nothing)
  72   where
  73   newoffset :: Instruction -> Int -> Offset
  74   newoffset x off = (off + (fromIntegral $ B.length $ encodeInstructions [x]), Nothing)
  75   cio' :: Offset -> [Instruction] -> [(Offset, Instruction)]
  76   cio' _ [] = []
  77   -- TODO(bernhard): add more instruction with offset (IF_ACMP, JSR, ...)
  78   -- TODO(bernhard): beautiful code please (BCP)
  79   cio' (off,_) (x@(IF _ w16):xs) = ((off, Just $ fromIntegral w16), x):(cio' (newoffset x off) xs)
  80   cio' (off,_) (x@(IF_ICMP _ w16):xs) = ((off, Just $ fromIntegral w16), x):(cio' (newoffset x off) xs)
  81   cio' (off,_) (x@(GOTO w16):xs) = ((off, Just $ fromIntegral w16), x):(cio' (newoffset x off) xs)
  82   cio' (off,_) (x:xs) = ((off, Nothing), x):(cio' (newoffset x off) xs)