%.class: %.java
javac $<
-trap.o mate: Mate.hs ./src/Utilities.hs trap.c
+trap.o mate: Mate.hs trap.c
ghc --make -Wall -O2 $^ -o mate
clean:
rm -f *.hi *.o mate src/*.class
-tags: Mate.hs src/Utilities.hs trap.o
+tags: Mate.hs Mate/Utilities.hs trap.o
@# @-fforce-recomp, see
@# http://stackoverflow.com/questions/7137414/how-do-i-force-interpretation-in-hint
ghc -fforce-recomp -e :ctags $^
import Harpy
import Harpy.X86Disassembler
-import Utilities
+import Mate.Utilities
foreign import ccall "dynamic"
code_void :: FunPtr (CInt -> IO CInt) -> (CInt -> IO CInt)
--- /dev/null
+{-# LANGUAGE OverloadedStrings #-}
+module Mate.BasicBlocks where
+
+import Data.Binary
+import System.Environment
+import qualified Data.Map as M
+import qualified Data.ByteString.Lazy as B
+
+import JVM.Common
+import JVM.ClassFile
+import JVM.Converter
+import JVM.Dump
+import JVM.Assembler
+
+import Mate.Utilities
+
+type Name = String -- use "virtual register id" instead?
+data Type = JInt | JFloat -- add more
+type Variable = (Type,Name)
+
+-- Represents a CFG node
+data BasicBlock = BasicBlock {
+ inputs :: [Variable],
+ outputs :: [Variable],
+ code :: [Instruction] }
+
+-- Represents a Control-Flow-Graph as
+-- Adjacency list (add matrix representation if appropriate)
+type CFList = [(BasicBlock, [BasicBlock])]
+
+
+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
+ mapM_ putStrLn (testCFG mainmethod)
+
+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) -> [String]
+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"
+
+
+buildCFG :: [Instruction] -> [String]
+buildCFG xs = map show xs
--- /dev/null
+module Mate.RegisterAllocation where
+
+import Data.List
+import Data.Maybe
+
+
+type Label a = a
+type IEdge a = (Label a, Label a)
+data IGraph a = IGraph [IEdge a] deriving (Show)
+
+-- TODO: make IEdge eq
+
+--data IArchitecture = Arch { regs :: Integer }
+type IArchitecture = Int --number of regs
+
+
+type Assignment a = (a, Int)
+
+
+edgeEq (from,to) (from',to') = from == from' && to == to'
+
+
+-- TODO: find combinator do match try semantics here
+-- Solution: use list because list is MonadPlus instance
+-- other solution add maybe monadplus implementation
+conflicts (IGraph xs) (label,anotherLabel) = let comparison = edgeEq (label,anotherLabel)
+ comparison' = edgeEq (anotherLabel,label)
+ in isJust (find comparison xs) || isJust (find comparison' xs)
+
+
+isParticipiant label (from,to) = from == label || to == label
+
+count p = length . filter p
+
+degree g@(IGraph xs) label = count (isParticipiant label) xs
+
+
+doChaitin81 :: (Eq a) => IArchitecture -> (IGraph a) -> [Assignment a]
+doChaitin81 numberOfRegisters graph = []
+
+type IState a = ([a],IGraph a)
+
+--chait81Simplification :: (Eq a) => IArchitecture -> SimplState
+--chait81Simplification regs = do (
+
+testGraph = IGraph [("a", "b"), ("a","c"), ("c", "b"), ("b","d"), ("d","c"),("b","e"),("d","e")]
+
+
--- /dev/null
+module Mate.Utilities where
+
+import qualified Data.ByteString.Lazy as B
+
+import qualified JVM.Assembler as J
+import JVM.Assembler hiding (Instruction)
+import JVM.Common
+import JVM.ClassFile
+
+
+-- TODO: actually this function already exists in hs-java-0.3!
+lookupMethod :: B.ByteString -> Class Resolved -> Maybe (Method Resolved)
+lookupMethod name cls = look (classMethods cls)
+ where
+ look [] = Nothing
+ look (f:fs)
+ | methodName f == name = Just f
+ | otherwise = look fs
+++ /dev/null
-{-# LANGUAGE OverloadedStrings #-}
-module BasicBlocks where
-
-import Data.Binary
-import System.Environment
-import qualified Data.Map as M
-import qualified Data.ByteString.Lazy as B
-
-import JVM.Common
-import JVM.ClassFile
-import JVM.Converter
-import JVM.Dump
-import JVM.Assembler
-
-import Utilities
-
-type Name = String -- use "virtual register id" instead?
-data Type = JInt | JFloat -- add more
-type Variable = (Type,Name)
-
--- Represents a CFG node
-data BasicBlock = BasicBlock {
- inputs :: [Variable],
- outputs :: [Variable],
- code :: [Instruction] }
-
--- Represents a Control-Flow-Graph as
--- Adjacency list (add matrix representation if appropriate)
-type CFList = [(BasicBlock, [BasicBlock])]
-
-
-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
- mapM_ putStrLn (testCFG mainmethod)
-
-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) -> [String]
-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"
-
-
-buildCFG :: [Instruction] -> [String]
-buildCFG xs = map show xs
+++ /dev/null
-import Data.List
-import Data.Maybe
-
-
-type Label a = a
-type IEdge a = (Label a, Label a)
-data IGraph a = IGraph [IEdge a] deriving (Show)
-
--- TODO: make IEdge eq
-
---data IArchitecture = Arch { regs :: Integer }
-type IArchitecture = Int --number of regs
-
-
-type Assignment a = (a, Int)
-
-
-edgeEq (from,to) (from',to') = from == from' && to == to'
-
-
--- TODO: find combinator do match try semantics here
--- Solution: use list because list is MonadPlus instance
--- other solution add maybe monadplus implementation
-conflicts (IGraph xs) (label,anotherLabel) = let comparison = edgeEq (label,anotherLabel)
- comparison' = edgeEq (anotherLabel,label)
- in isJust (find comparison xs) || isJust (find comparison' xs)
-
-
-isParticipiant label (from,to) = from == label || to == label
-
-count p = length . filter p
-
-degree g@(IGraph xs) label = count (isParticipiant label) xs
-
-
-doChaitin81 :: (Eq a) => IArchitecture -> (IGraph a) -> [Assignment a]
-doChaitin81 numberOfRegisters graph = []
-
-type IState a = ([a],IGraph a)
-
---chait81Simplification :: (Eq a) => IArchitecture -> SimplState
---chait81Simplification regs = do (
-
-testGraph = IGraph [("a", "b"), ("a","c"), ("c", "b"), ("b","d"), ("d","c"),("b","e"),("d","e")]
-
-
+++ /dev/null
-module Utilities where
-
-import qualified Data.ByteString.Lazy as B
-
-import qualified JVM.Assembler as J
-import JVM.Assembler hiding (Instruction)
-import JVM.Common
-import JVM.ClassFile
-
-
--- TODO: actually this function already exists in hs-java-0.3!
-lookupMethod :: B.ByteString -> Class Resolved -> Maybe (Method Resolved)
-lookupMethod name cls = look (classMethods cls)
- where
- look [] = Nothing
- look (f:fs)
- | methodName f == name = Just f
- | otherwise = look fs