From dedebead7a042963f8445ecd23858418b0f8c573 Mon Sep 17 00:00:00 2001 From: Bernhard Urban Date: Sun, 22 Apr 2012 20:42:50 +0200 Subject: [PATCH] modules: move (public) datatypes into a new module --- Mate.hs | 2 +- Mate/BasicBlocks.hs | 16 ++--------- Mate/MethodPool.hs | 11 ++----- Mate/Types.hs | 70 +++++++++++++++++++++++++++++++++++++++++++++ Mate/Utilities.hs | 42 +-------------------------- Mate/X86CodeGen.hs | 5 +--- 6 files changed, 78 insertions(+), 68 deletions(-) create mode 100644 Mate/Types.hs diff --git a/Mate.hs b/Mate.hs index 1acc64d..05754be 100644 --- a/Mate.hs +++ b/Mate.hs @@ -16,7 +16,7 @@ import JVM.Dump import Mate.BasicBlocks import Mate.X86CodeGen import Mate.MethodPool -import Mate.Utilities +import Mate.Types main :: IO () main = do diff --git a/Mate/BasicBlocks.hs b/Mate/BasicBlocks.hs index 59e3052..229325d 100644 --- a/Mate/BasicBlocks.hs +++ b/Mate/BasicBlocks.hs @@ -21,22 +21,10 @@ import JVM.Converter import JVM.Assembler import Mate.Utilities +import Mate.Types -type BlockID = Int --- Represents a CFG node -data BasicBlock = BasicBlock { - -- inputs :: [Variable], - -- outputs :: [Variable], - code :: [Instruction], - successor :: BBEnd } - --- describes (leaving) edges of a CFG node -data BBEnd = Return | FallThrough BlockID | OneTarget BlockID | TwoTarget BlockID BlockID deriving Show - -type MapBB = M.Map BlockID BasicBlock - --- for immediate representation for determine BBs +-- for immediate representation to determine BBs type Offset = (Int, Maybe BBEnd) -- (offset in bytecode, offset to jump target) type OffIns = (Offset, Instruction) diff --git a/Mate/MethodPool.hs b/Mate/MethodPool.hs index 2cd739e..762e787 100644 --- a/Mate/MethodPool.hs +++ b/Mate/MethodPool.hs @@ -19,8 +19,8 @@ import Harpy import Harpy.X86Disassembler import Mate.BasicBlocks +import Mate.Types import Mate.X86CodeGen -import Mate.Utilities foreign import ccall "get_mmap" @@ -29,11 +29,6 @@ foreign import ccall "get_mmap" foreign import ccall "set_mmap" set_mmap :: Ptr () -> IO () - --- B.ByteString = name of method --- Word32 = entrypoint of method -type MMap = M.Map MethodInfo Word32 - foreign export ccall getMethodEntry :: CUInt -> Ptr () -> Ptr () -> IO CUInt getMethodEntry :: CUInt -> Ptr () -> Ptr () -> IO CUInt getMethodEntry signal_from ptr_mmap ptr_cmap = do @@ -41,7 +36,7 @@ getMethodEntry signal_from ptr_mmap ptr_cmap = do cmap <- ptr2cmap ptr_cmap let w32_from = fromIntegral signal_from - let mi@(MethodInfo method cm sig cpidx) = cmap M.! w32_from + let mi@(MethodInfo method cm _ cpidx) = cmap M.! w32_from -- TODO(bernhard): replace parsing with some kind of classpool cls <- parseClassFile $ toString $ cm `B.append` ".class" case M.lookup mi mmap of @@ -79,7 +74,7 @@ compileBB hmap methodinfo = do cmap <- get_cmap >>= ptr2cmap -- TODO(bernhard): replace parsing with some kind of classpool - cls <- parseClassFile $ toString $ (classname methodinfo) `B.append` ".class" + cls <- parseClassFile $ toString $ (cName methodinfo) `B.append` ".class" let ebb = emitFromBB cls hmap (_, Right ((entry, _, _, new_cmap), disasm)) <- runCodeGen ebb () () let w32_entry = ((fromIntegral $ ptrToIntPtr entry) :: Word32) diff --git a/Mate/Types.hs b/Mate/Types.hs new file mode 100644 index 0000000..95ae4e4 --- /dev/null +++ b/Mate/Types.hs @@ -0,0 +1,70 @@ +module Mate.Types where + +import Data.Char +import Data.Word +import qualified Data.Map as M +import qualified Data.ByteString.Lazy as B +import Codec.Binary.UTF8.String hiding (encode,decode) + +import JVM.ClassFile +import JVM.Assembler + + +type BlockID = Int +-- Represents a CFG node +data BasicBlock = BasicBlock { + code :: [Instruction], + successor :: BBEnd } + +-- describes (leaving) edges of a CFG node +data BBEnd = Return | FallThrough BlockID | OneTarget BlockID | TwoTarget BlockID BlockID deriving Show + +type MapBB = M.Map BlockID BasicBlock + + +-- Word32 = point of method call in generated code +-- MethodInfo = relevant information about callee +type CMap = M.Map Word32 MethodInfo + +-- B.ByteString = name of method +-- Word32 = entrypoint of method +type MMap = M.Map MethodInfo Word32 + + + +data MethodInfo = MethodInfo { + methName :: B.ByteString, + cName :: B.ByteString, + mSignature :: MethodSignature, + cpIndex :: Word16 } + +instance Eq MethodInfo where + (MethodInfo m_a c_a s_a i_a) == (MethodInfo m_b c_b s_b i_b) = + (m_a == m_b) && (c_a == c_b) && (s_a == s_b) && (i_a == i_b) + +-- TODO(bernhard): not really efficient. also, outsource that to hs-java +instance Ord MethodSignature where + compare (MethodSignature args_a ret_a) (MethodSignature args_b ret_b) + | cmp_args /= EQ = cmp_args + | otherwise = (show ret_a) `compare` (show ret_b) + where + cmp_args = (show args_a) `compare` (show args_b) + +instance Ord MethodInfo where + compare (MethodInfo m_a c_a s_a i_a) (MethodInfo m_b c_b s_b i_b) + | cmp_m /= EQ = cmp_m + | cmp_c /= EQ = cmp_c + | cmp_s /= EQ = cmp_s + | otherwise = i_a `compare` i_b + where + cmp_m = m_a `compare` m_b + cmp_c = c_a `compare` c_b + cmp_s = s_a `compare` s_b + +instance Show MethodInfo where + show (MethodInfo method c sig idx) = + (toString c) ++ "." ++ (toString method) ++ "." ++ (show sig) ++ "@" ++ (show idx) + + +toString :: B.ByteString -> String +toString bstr = decodeString $ map (chr . fromIntegral) $ B.unpack bstr diff --git a/Mate/Utilities.hs b/Mate/Utilities.hs index a73d60c..7002d19 100644 --- a/Mate/Utilities.hs +++ b/Mate/Utilities.hs @@ -1,50 +1,13 @@ {-# LANGUAGE OverloadedStrings #-} module Mate.Utilities where -import Data.Char import Data.Word import qualified Data.Map as M import qualified Data.ByteString.Lazy as B --- import qualified Data.ByteString.Lazy.Char8 as B8 -import Codec.Binary.UTF8.String hiding (encode,decode) import JVM.ClassFile -import Debug.Trace - - -data MethodInfo = MethodInfo { - methodname :: B.ByteString, - classname :: B.ByteString, - signature :: MethodSignature, - index :: Word16 } - -instance Eq MethodInfo where - (MethodInfo m_a c_a s_a i_a) == (MethodInfo m_b c_b s_b i_b) = - (m_a == m_b) && (c_a == c_b) && (s_a == s_b) && (i_a == i_b) - --- TODO(bernhard): not really efficient. also, outsource that to hs-java -instance Ord MethodSignature where - compare (MethodSignature args_a ret_a) (MethodSignature args_b ret_b) - | cmp_args /= EQ = cmp_args - | otherwise = (show ret_a) `compare` (show ret_b) - where - cmp_args = (show args_a) `compare` (show args_b) - -instance Ord MethodInfo where - compare (MethodInfo m_a c_a s_a i_a) (MethodInfo m_b c_b s_b i_b) - | cmp_m /= EQ = cmp_m - | cmp_c /= EQ = cmp_c - | cmp_s /= EQ = cmp_s - | otherwise = i_a `compare` i_b - where - cmp_m = m_a `compare` m_b - cmp_c = c_a `compare` c_b - cmp_s = s_a `compare` s_b - -instance Show MethodInfo where - show (MethodInfo method c sig idx) = - (toString c) ++ "." ++ (toString method) ++ "." ++ (show sig) ++ "@" ++ (show idx) +import Mate.Types -- TODO: actually this function already exists in hs-java-0.3! @@ -56,9 +19,6 @@ lookupMethod name cls = look (classMethods cls) | methodName f == name = Just f | otherwise = look fs -toString :: B.ByteString -> String -toString bstr = decodeString $ map (chr . fromIntegral) $ B.unpack bstr - buildMethodID :: Class Resolved -> Word16 -> MethodInfo buildMethodID cls idx = MethodInfo (ntName nt) rc (ntSignature nt) idx where diff --git a/Mate/X86CodeGen.hs b/Mate/X86CodeGen.hs index d2c9caf..21d2b3c 100644 --- a/Mate/X86CodeGen.hs +++ b/Mate/X86CodeGen.hs @@ -23,6 +23,7 @@ import Harpy import Harpy.X86Disassembler import Mate.BasicBlocks +import Mate.Types import Mate.Utilities foreign import ccall "dynamic" @@ -119,10 +120,6 @@ type BBStarts = M.Map BlockID Int type CompileInfo = (EntryPoint, BBStarts, Int, CMap) --- Word32 = point of method call in generated code --- MethodInfo = relevant information about callee -type CMap = M.Map Word32 MethodInfo - emitFromBB :: Class Resolved -> MapBB -> CodeGen e s (CompileInfo, [Instruction]) emitFromBB cls hmap = do -- 2.25.1