From: Bernhard Urban Date: Mon, 2 Apr 2012 19:40:00 +0000 (+0200) Subject: src: move files into a Mate package X-Git-Url: http://wien.tomnetworks.com/gitweb/?p=mate.git;a=commitdiff_plain;h=3558633cda85024f2e9e3c2c6bb4aca289b1e3eb src: move files into a Mate package hence, ghc(i) is able to figuring out the correct path --- diff --git a/Makefile b/Makefile index b82354e..3fcf204 100644 --- a/Makefile +++ b/Makefile @@ -10,13 +10,13 @@ test: mate %.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 $^ diff --git a/Mate.hs b/Mate.hs index f659455..a8e18e4 100644 --- a/Mate.hs +++ b/Mate.hs @@ -27,7 +27,7 @@ import Foreign.C.Types import Harpy import Harpy.X86Disassembler -import Utilities +import Mate.Utilities foreign import ccall "dynamic" code_void :: FunPtr (CInt -> IO CInt) -> (CInt -> IO CInt) diff --git a/Mate/BasicBlocks.hs b/Mate/BasicBlocks.hs new file mode 100644 index 0000000..1db0710 --- /dev/null +++ b/Mate/BasicBlocks.hs @@ -0,0 +1,63 @@ +{-# 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 diff --git a/Mate/RegisterAllocation.hs b/Mate/RegisterAllocation.hs new file mode 100644 index 0000000..9fc43ae --- /dev/null +++ b/Mate/RegisterAllocation.hs @@ -0,0 +1,48 @@ +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")] + + diff --git a/Mate/Utilities.hs b/Mate/Utilities.hs new file mode 100644 index 0000000..8733ca3 --- /dev/null +++ b/Mate/Utilities.hs @@ -0,0 +1,18 @@ +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 diff --git a/src/BasicBlocks.hs b/src/BasicBlocks.hs deleted file mode 100644 index e37979b..0000000 --- a/src/BasicBlocks.hs +++ /dev/null @@ -1,63 +0,0 @@ -{-# 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 diff --git a/src/RegisterAllocation.hs b/src/RegisterAllocation.hs deleted file mode 100644 index 0e8dac8..0000000 --- a/src/RegisterAllocation.hs +++ /dev/null @@ -1,46 +0,0 @@ -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")] - - diff --git a/src/Utilities.hs b/src/Utilities.hs deleted file mode 100644 index 540d054..0000000 --- a/src/Utilities.hs +++ /dev/null @@ -1,18 +0,0 @@ -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