Updates (not compiling).

diff --git a/JVM/Assembler.hs b/JVM/Assembler.hs
index a3162c0296b02dd2a685364ffecbb454b7faf2a9..f141389d5f10b7c234f03aa9bb8538eaf79983af 100644 (file)
--- 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 2c58cec3e5502db15a05f8b783fc30cc1f7da410..41cf05f68fe0fe2d9ec7e3319764159b448aa1b5 100644 (file)
--- 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 18f57ea98594016c6d33321c1c63a1ea39b675bd..9c96144791e4741f10c0c66cd5be416d7c2f75fe 100644 (file)
--- 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 bb6512f6ad3a7a80b214720e9613019d6429a44c..37a52e614dd189f7b7cc01be1360eb35cf6e9b2e 100644 (file)
--- 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"
+