src/BasicBlocks.hs

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