From 4c504fbb0b276782af6cd250e5e9fd4fdcc26967 Mon Sep 17 00:00:00 2001 From: Bernhard Urban Date: Sat, 19 May 2012 15:56:18 +0200 Subject: [PATCH] hs-java: upgrade to 0.3.1 0.3 has JAR support, so stay tuned \o/ --- Mate.hs | 2 +- Mate/BasicBlocks.hs | 5 ++--- Mate/ClassPool.hs | 7 +++---- Mate/MethodPool.hs | 5 ++--- Mate/Strings.hs | 2 ++ Mate/Types.hs | 8 ++++---- Mate/Utilities.hs | 21 ++++++--------------- Mate/X86CodeGen.hs | 2 +- mate.cabal | 2 +- tools/installhaskellenv.sh | 1 - 10 files changed, 22 insertions(+), 33 deletions(-) diff --git a/Mate.hs b/Mate.hs index d60df06..911c1db 100644 --- a/Mate.hs +++ b/Mate.hs @@ -30,7 +30,7 @@ main = do hmap <- parseMethod cls "main" case hmap of Just hmap' -> do - let methods = classMethods cls; methods :: [Method Resolved] + let methods = classMethods cls; methods :: [Method Direct] let method = find (\x -> methodName x == "main") methods case method of Just m -> do diff --git a/Mate/BasicBlocks.hs b/Mate/BasicBlocks.hs index 3c0b93c..b52f22d 100644 --- a/Mate/BasicBlocks.hs +++ b/Mate/BasicBlocks.hs @@ -24,7 +24,6 @@ import JVM.ClassFile import JVM.Converter import JVM.Assembler -import Mate.Utilities import Mate.Types import Mate.Debug @@ -86,7 +85,7 @@ test_04 = testInstance "./tests/Fac.class" "fac" #endif -parseMethod :: Class Resolved -> B.ByteString -> IO (Maybe MapBB) +parseMethod :: Class Direct -> B.ByteString -> IO (Maybe MapBB) parseMethod cls method = do let maybe_bb = testCFG $ lookupMethod method cls let msig = methodSignature $ classMethods cls !! 1 @@ -104,7 +103,7 @@ parseMethod cls method = do return maybe_bb -testCFG :: Maybe (Method Resolved) -> Maybe MapBB +testCFG :: Maybe (Method Direct) -> Maybe MapBB testCFG (Just m) = case attrByName m "Code" of Nothing -> Nothing Just bytecode -> Just $ buildCFG $ codeInstructions $ decodeMethod bytecode diff --git a/Mate/ClassPool.hs b/Mate/ClassPool.hs index 2161947..f9f1038 100644 --- a/Mate/ClassPool.hs +++ b/Mate/ClassPool.hs @@ -38,7 +38,6 @@ import JVM.Converter import Mate.BasicBlocks import {-# SOURCE #-} Mate.MethodPool import Mate.Types -import Mate.Utilities import Mate.Debug import Mate.GarbageAlloc @@ -49,7 +48,7 @@ getClassInfo path = do Nothing -> loadAndInitClass path Just ci -> return ci -getClassFile :: B.ByteString -> IO (Class Resolved) +getClassFile :: B.ByteString -> IO (Class Direct) getClassFile path = do ci <- getClassInfo path return $ ciFile ci @@ -183,7 +182,7 @@ loadInterface path = do getname p y = p `B.append` methodName y `B.append` encode (methodSignature y) -calculateFields :: Class Resolved -> Maybe ClassInfo -> IO (FieldMap, FieldMap) +calculateFields :: Class Direct -> Maybe ClassInfo -> IO (FieldMap, FieldMap) calculateFields cf superclass = do -- TODO(bernhard): correct sizes. int only atm @@ -212,7 +211,7 @@ getsupermap :: Maybe ClassInfo -> (ClassInfo -> FieldMap) -> FieldMap getsupermap superclass getter = case superclass of Just x -> getter x; Nothing -> M.empty -calculateMethodMap :: Class Resolved -> Maybe ClassInfo -> IO (FieldMap, Word32) +calculateMethodMap :: Class Direct -> Maybe ClassInfo -> IO (FieldMap, Word32) calculateMethodMap cf superclass = do let methods = filter (\x -> (not . S.member ACC_STATIC . methodAccessFlags) x && diff --git a/Mate/MethodPool.hs b/Mate/MethodPool.hs index 216a287..c243d11 100644 --- a/Mate/MethodPool.hs +++ b/Mate/MethodPool.hs @@ -27,7 +27,6 @@ import Text.Printf import Mate.BasicBlocks import Mate.Types import Mate.X86CodeGen -import Mate.Utilities import Mate.ClassPool import Mate.Debug @@ -82,8 +81,8 @@ getMethodEntry signal_from methodtable = do Nothing -> error $ show method ++ " not found. abort" Just w32 -> return (fromIntegral w32) -lookupMethodRecursive :: B.ByteString -> [B.ByteString] -> Class Resolved - -> IO (Maybe (Method Resolved, [B.ByteString], Class Resolved)) +lookupMethodRecursive :: B.ByteString -> [B.ByteString] -> Class Direct + -> IO (Maybe (Method Direct, [B.ByteString], Class Direct)) lookupMethodRecursive name clsnames cls = case res of Just x -> return $ Just (x, nextclsn, cls) diff --git a/Mate/Strings.hs b/Mate/Strings.hs index 794af0f..f1762b0 100644 --- a/Mate/Strings.hs +++ b/Mate/Strings.hs @@ -13,6 +13,8 @@ import qualified Data.ByteString.Internal as BI import Text.Printf #endif +import JVM.ClassFile + import Foreign.Ptr import Foreign.Marshal.Utils import Foreign.Marshal.Array diff --git a/Mate/Types.hs b/Mate/Types.hs index 79b0396..0f8b4a9 100644 --- a/Mate/Types.hs +++ b/Mate/Types.hs @@ -2,12 +2,10 @@ {-# LANGUAGE ForeignFunctionInterface #-} module Mate.Types where -import Data.Char import Data.Word import Data.Int import qualified Data.Map as M import qualified Data.ByteString.Lazy as B -import Codec.Binary.UTF8.String hiding (encode,decode) import Data.IORef import System.IO.Unsafe @@ -74,7 +72,7 @@ type ClassMap = M.Map B.ByteString ClassInfo data ClassInfo = ClassInfo { ciName :: B.ByteString, - ciFile :: Class Resolved, + ciFile :: Class Direct, ciStaticMap :: FieldMap, ciFieldMap :: FieldMap, ciMethodMap :: FieldMap, @@ -98,14 +96,16 @@ type VirtualMap = M.Map Word32 B.ByteString -- store each parsed Interface upon first loading -type InterfaceMap = M.Map B.ByteString (Class Resolved) +type InterfaceMap = M.Map B.ByteString (Class Direct) -- store offset for each pair type InterfaceMethodMap = M.Map B.ByteString Word32 +{- toString :: B.ByteString -> String toString bstr = decodeString $ map (chr . fromIntegral) $ B.unpack bstr +-} data MateCtx = MateCtx { diff --git a/Mate/Utilities.hs b/Mate/Utilities.hs index 4d1cd07..4ae0bac 100644 --- a/Mate/Utilities.hs +++ b/Mate/Utilities.hs @@ -11,35 +11,26 @@ import JVM.ClassFile import Mate.Types --- 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 - -buildMethodID :: Class Resolved -> Word16 -> MethodInfo +buildMethodID :: Class Direct -> Word16 -> MethodInfo buildMethodID cls idx = MethodInfo (ntName nt) rc (ntSignature nt) where (rc, nt) = case constsPool cls M.! idx of (CMethod rc' nt') -> (rc', nt') (CIfaceMethod rc' nt') -> (rc', nt') _ -> error "buildMethodID: something wrong. abort." -buildStaticFieldID :: Class Resolved -> Word16 -> StaticFieldInfo +buildStaticFieldID :: Class Direct -> Word16 -> StaticFieldInfo buildStaticFieldID cls idx = StaticFieldInfo rc (ntName fnt) where (CField rc fnt) = constsPool cls M.! idx -buildFieldOffset :: Class Resolved -> Word16 -> (B.ByteString, B.ByteString) +buildFieldOffset :: Class Direct -> Word16 -> (B.ByteString, B.ByteString) buildFieldOffset cls idx = (rc, ntName fnt) where (CField rc fnt) = constsPool cls M.! idx -buildClassID :: Class Resolved -> Word16 -> B.ByteString +buildClassID :: Class Direct -> Word16 -> B.ByteString buildClassID cls idx = cl where (CClass cl) = constsPool cls M.! idx -methodGetArgsCount :: Class Resolved -> Word16 -> Word32 +methodGetArgsCount :: Class Direct -> Word16 -> Word32 methodGetArgsCount cls idx = fromIntegral $ length args where nt = case constsPool cls M.! idx of @@ -49,7 +40,7 @@ methodGetArgsCount cls idx = fromIntegral $ length args (MethodSignature args _) = ntSignature nt -- TODO(bernhard): Extend it to more than just int, and provide typeinformation -methodHaveReturnValue :: Class Resolved -> Word16 -> Bool +methodHaveReturnValue :: Class Direct -> Word16 -> Bool methodHaveReturnValue cls idx = case ret of ReturnsVoid -> False; (Returns IntType) -> True; diff --git a/Mate/X86CodeGen.hs b/Mate/X86CodeGen.hs index 1b4ef95..a44a5d0 100644 --- a/Mate/X86CodeGen.hs +++ b/Mate/X86CodeGen.hs @@ -45,7 +45,7 @@ type BBStarts = M.Map BlockID Int type CompileInfo = (EntryPoint, BBStarts, Int, TrapMap) -emitFromBB :: B.ByteString -> Class Resolved -> MapBB -> CodeGen e s (CompileInfo, [Instruction]) +emitFromBB :: B.ByteString -> Class Direct -> MapBB -> CodeGen e s (CompileInfo, [Instruction]) emitFromBB method cls hmap = do llmap <- sequence [newNamedLabel ("bb_" ++ show x) | (x,_) <- M.toList hmap] let lmap = zip (Prelude.fst $ unzip $ M.toList hmap) llmap diff --git a/mate.cabal b/mate.cabal index 4ce578e..96f31b6 100644 --- a/mate.cabal +++ b/mate.cabal @@ -8,7 +8,7 @@ copyright: maintainer: lewurm@gmail.com, haraldsteinlechner@gmail.com build-depends: base -any, mate-common -any, - hs-java ==0.2.0.99, + hs-java ==0.3.1, bytestring -any, harpy ==0.4.3.99, heap -any, diff --git a/tools/installhaskellenv.sh b/tools/installhaskellenv.sh index 175b707..159d252 100755 --- a/tools/installhaskellenv.sh +++ b/tools/installhaskellenv.sh @@ -23,7 +23,6 @@ rm -rf harpy git clone git://wien.tomnetworks.com/hs-java.git cd hs-java -git checkout -t origin/v0.2 cabal install --enable-shared cd .. rm -rf hs-java -- 2.25.1