From: Ilya Portnov Date: Wed, 14 Sep 2011 17:54:28 +0000 (+0600) Subject: Updates (not compiling). X-Git-Tag: v0.3.2~47 X-Git-Url: http://wien.tomnetworks.com/gitweb/?p=hs-java.git;a=commitdiff_plain;h=f6998fe3bda57731151b1438ad10dde0572f3e7f Updates (not compiling). --- diff --git a/JVM/Assembler.hs b/JVM/Assembler.hs index a3162c0..f141389 100644 --- a/JVM/Assembler.hs +++ b/JVM/Assembler.hs @@ -9,7 +9,9 @@ module JVM.Assembler CodeException (..), Code (..), IMM (..), - CMP (..) + CMP (..), + encodeMethod, + decodeMethod ) where @@ -704,3 +706,11 @@ instance BinaryState Integer Instruction where | inRange (159, 164) c -> IF_ICMP (toEnum $ fromIntegral $ c-159) <$> get | otherwise -> fail $ "Unknown instruction byte code: " ++ show c +-- | Decode Java method +decodeMethod :: B.ByteString -> Code +decodeMethod str = decodeS (0 :: Integer) str + +-- | Encode Java method +encodeMethod :: Code -> B.ByteString +encodeMethod code = encodeS (0 :: Integer) code + diff --git a/JVM/Converter.hs b/JVM/Converter.hs index 2c58cec..41cf05f 100644 --- a/JVM/Converter.hs +++ b/JVM/Converter.hs @@ -2,7 +2,7 @@ -- | Functions to convert from low-level .class format representation and -- high-level Java classes, methods etc representation module JVM.Converter - (decompile, decompileFile, + (parseClass, parseClassFile, convertClass, methodByName, attrByName, @@ -23,12 +23,15 @@ import JVM.ClassFile import JVM.Types -- | Parse .class file data -decompile :: B.ByteString -> Class -decompile bstr = convertClass $ decode bstr +parseClass :: B.ByteString -> Class +parseClass bstr = convertClass $ decode bstr -- | Parse class data from file -decompileFile :: FilePath -> IO Class -decompileFile path = convertClass `fmap` decodeFile path +parseClassFile :: FilePath -> IO Class +parseClassFile path = convertClass `fmap` decodeFile path + +encodeClass :: Class -> B.ByteString +encodeClass cls = encode $ classFile cls convertClass :: ClassFile -> Class convertClass (ClassFile {..}) = @@ -44,6 +47,83 @@ convertClass (ClassFile {..}) = methods = map (convertMethod pool) classMethods, classAttrs = convertAttrs pool classAttributes } +classFile :: Class -> ClassFile +classFile (Class {..}) = ClassFile { + magic = 0xCAFEBABE, + minorVersion = 0, + majorVersion = 50, + constsPoolSize = fromIntegral (length poolInfo), + constsPool = poolInfo, + accessFlags = access2word16 classAccess, + thisClass = poolIndex poolInfo this, + superClass = poolIndex poolInfo this, + interfacesCount = fromIntegral (length implements), + interfaces = map (poolIndex poolInfo) implements, + classFieldsCount = fromIntegral (length fields), + classFields = map (fieldInfo poolInfo) fields, + classMethodsCount = fromIntegral (length methods), + classMethods = map (methodInfo poolInfo) methods, + classAttributesCount = fromIntegral (M.size classAttrs), + classAttributes = map (attrInfo poolInfo) (M.assocs classAttrs) } + where + poolInfo = toCPInfo constantPool + +toCPInfo :: Pool -> [CpInfo] +toCPInfo pool = result + where + result = map cpInfo $ elems pool + + cpInfo (CClass name) = CONSTANT_Class (poolIndex result name) + cpInfo (CField cls name) = + CONSTANT_Fieldref (poolIndex result cls) (poolIndex result name) + cpInfo (CMethod cls name) = + CONSTANT_Methodref (poolIndex result cls) (poolIndex result name) + cpInfo (CIfaceMethod cls name) = + CONSTANT_InterfaceMethodref (poolIndex result cls) (poolIndex result name) + cpInfo (CString s) = CONSTANT_String (poolIndex result s) + cpInfo (CInteger x) = CONSTANT_Integer x + cpInfo (CFloat x) = CONSTANT_Float x + cpInfo (CLong x) = CONSTANT_Long (fromIntegral x) + cpInfo (CDouble x) = CONSTANT_Double x + cpInfo (CNameType n t) = + CONSTANT_NameAndType (poolIndex result n) (poolIndex result t) + cpInfo (CUTF8 s) = CONSTANT_Utf8 (fromIntegral $ B.length s) s + cpInfo (CUnicode s) = CONSTANT_Unicode (fromIntegral $ B.length s) s + +poolIndex :: [CpInfo] -> B.ByteString -> Word16 +poolIndex list name = case findIndex test list of + Nothing -> error $ "Internal error: no such item in pool: " ++ toString name + Just i -> fromIntegral i + where + test (CUTF8 s) | s == name = True + test (CUnicode s) | s == name = True + test _ = False + + + +fieldInfo :: [CpInfo] -> Field -> FieldInfo +fieldInfo pool (Field {..}) = FieldInfo { + fieldAccessFlags = access2word16 fieldAccess, + fieldNameIndex = poolIndex pool fieldName, + fieldSignatureIndex = poolIndex pool (encode fieldSignature), + fieldAttributesCount = fromIntegral (M.size fieldAttrs), + fieldAttributes = map (attrInfo pool) (M.assocs fieldAttrs) } + +methodInfo :: [CpInfo] -> Method -> MethodInfo +methodInfo pool (Method {..}) = MethodInfo { + methodAccessFlags = access2word16 methodAccess, + methodNameIndex = poolIndex pool methodName, + methodSignatureIndex = poolIndex pool (encode methodSignature), + methodAttributesCount = fromIntegral (M.size methodAttrs), + methodAttributes = map (attrInfo pool) (M.assocs methodAttrs) } + +attrInfo :: [CpInfo] -> (B.ByteString, B.ByteString) -> AttributeInfo +attrInfo pool (name, value) = AttributeInfo { + attributeName = poolIndex pool name, + attributeLength = fromIntegral (B.length value), + attributeValue = value } + + constantPoolArray :: [CpInfo] -> Pool constantPoolArray list = pool where @@ -83,6 +163,12 @@ convertAccess w = S.fromList $ concat $ zipWith (\i f -> if testBit w i then [f] ACC_INTERFACE, ACC_ABSTRACT ] +access2word16 :: Access -> Word16 +access2word16 fs = bitsOr $ map toBit $ S.toList fs + where + bitsOr = foldl (.|.) 0 + toBit f = 1 `shiftL` (fromIntegral $ fromEnum f) + convertField :: Pool -> FieldInfo -> Field convertField pool (FieldInfo {..}) = Field { fieldAccess = convertAccess fieldAccessFlags, diff --git a/JVM/Types.hs b/JVM/Types.hs index 18f57ea..9c96144 100644 --- a/JVM/Types.hs +++ b/JVM/Types.hs @@ -128,7 +128,7 @@ data AccessFlag = | ACC_NATIVE -- ^ 0x0100 Implemented in other language | ACC_INTERFACE -- ^ 0x0200 Class is interface | ACC_ABSTRACT -- ^ 0x0400 - deriving (Eq, Show, Ord) + deriving (Eq, Show, Ord, Enum) -- | Generic attribute data Attribute = Attribute { diff --git a/dump-class.hs b/dump-class.hs index bb6512f..37a52e6 100644 --- a/dump-class.hs +++ b/dump-class.hs @@ -7,7 +7,6 @@ import System.Environment import qualified Data.ByteString.Lazy as B import Text.Printf -import Data.BinaryState import JVM.Types import JVM.Converter import JVM.Assembler @@ -16,7 +15,7 @@ main = do args <- getArgs case args of [clspath] -> do - cls <- decompileFile clspath + cls <- parseClassFile clspath putStr "Class: " B.putStrLn (this cls) putStrLn "Constants pool:" @@ -29,9 +28,10 @@ main = do print (methodSignature m) case attrByName m "Code" of Nothing -> putStrLn "(no code)\n" - Just bytecode -> let code = decodeS (0 :: Integer) bytecode + Just bytecode -> let code = decodeMethod bytecode in forM_ (codeInstructions code) $ \i -> do putStr " " print i - _ -> error "Synopsis: disassemble File.class" + _ -> error "Synopsis: dump-class File.class" +