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
import JVM.Converter
import JVM.Assembler
-import Mate.Utilities
import Mate.Types
import Mate.Debug
#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
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
import Mate.BasicBlocks
import {-# SOURCE #-} Mate.MethodPool
import Mate.Types
-import Mate.Utilities
import Mate.Debug
import Mate.GarbageAlloc
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
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
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 &&
import Mate.BasicBlocks
import Mate.Types
import Mate.X86CodeGen
-import Mate.Utilities
import Mate.ClassPool
import Mate.Debug
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)
import Text.Printf
#endif
+import JVM.ClassFile
+
import Foreign.Ptr
import Foreign.Marshal.Utils
import Foreign.Marshal.Array
{-# 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
data ClassInfo = ClassInfo {
ciName :: B.ByteString,
- ciFile :: Class Resolved,
+ ciFile :: Class Direct,
ciStaticMap :: FieldMap,
ciFieldMap :: FieldMap,
ciMethodMap :: FieldMap,
-- 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 <Interface><Method><Signature> pair
type InterfaceMethodMap = M.Map B.ByteString Word32
+{-
toString :: B.ByteString -> String
toString bstr = decodeString $ map (chr . fromIntegral) $ B.unpack bstr
+-}
data MateCtx = MateCtx {
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
(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;
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
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,
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