Properly parse Code attribute.

diff --git a/Data/BinaryState.hs b/Data/BinaryState.hs
index c2ab55d89cc119c02d672421fdd7e656d76d82cd..782e0c918f4bc635ed0489c1036cc2e1311fd3b1 100644 (file)
--- a/Data/BinaryState.hs
+++ b/Data/BinaryState.hs
@@ -36,6 +36,11 @@ encodeS s a = Put.runPut $ State.evalStateT (put a) s
 decodeS :: (BinaryState s a) => s -> B.ByteString -> a
 decodeS s str = Get.runGet (State.evalStateT get s) str
 
 decodeS :: (BinaryState s a) => s -> B.ByteString -> a
 decodeS s str = Get.runGet (State.evalStateT get s) str
 

+decodeWith :: GetState s a -> s -> B.ByteString -> a
+decodeWith getter s str =
+  let (x,_,_) = Get.runGetState (State.evalStateT getter s) str 0
+  in  x
+

 encodeFile :: BinaryState s a => FilePath -> s -> a -> IO ()
 encodeFile f s v = B.writeFile f (encodeS s v)
 
 encodeFile :: BinaryState s a => FilePath -> s -> a -> IO ()
 encodeFile f s v = B.writeFile f (encodeS s v)
 

diff --git a/JVM/Assembler.hs b/JVM/Assembler.hs
index bc45d80a5b53f7c3ad4e356be5c987582cc54fac..9c8d3d1cae922e6bd31548e9a8972d428e589bb2 100644 (file)
--- a/JVM/Assembler.hs
+++ b/JVM/Assembler.hs
@@ -17,6 +17,7 @@ import qualified Data.Set as S
 import qualified Data.Map as M
 
 import Data.BinaryState
 import qualified Data.Map as M
 
 import Data.BinaryState

+import JVM.ClassFile

 import JVM.Types
 
 data IMM =
 import JVM.Types
 
 data IMM =


@@ -35,20 +36,73 @@ data CMP =
   | C_LE
   deriving (Eq, Ord, Enum, Show)
 
   | C_LE
   deriving (Eq, Ord, Enum, Show)
 

-newtype Code = Code [Instruction]
+data Code = Code {
+    codeStackSize :: Word16,
+    codeMaxLocals :: Word16,
+    codeLength :: Word32,
+    codeInstructions :: [Instruction],
+    codeExceptionsN :: Word16,
+    codeExceptions :: [CodeException],
+    codeAttrsN :: Word16,
+    codeAttributes :: [AttributeInfo] }

   deriving (Eq, Show)
 
   deriving (Eq, Show)
 

+data CodeException = CodeException {
+    eStartPC :: Word16,
+    eEndPC :: Word16,
+    eHandlerPC :: Word16,
+    eCatchType :: Word16 }
+  deriving (Eq, Show)
+
+instance BinaryState Integer CodeException where
+  put (CodeException {..}) = do
+    put eStartPC
+    put eEndPC
+    put eHandlerPC
+    put eCatchType
+
+  get = CodeException <$> get <*> get <*> get <*> get
+
+instance BinaryState Integer AttributeInfo where
+  put a = do
+    let sz = 6 + attributeLength a      -- full size of AttributeInfo structure
+    liftOffset (fromIntegral sz) Binary.put a
+
+  get = getZ
+

 instance BinaryState Integer Code where
 instance BinaryState Integer Code where

-  put (Code list) = forM_ list put
+  put (Code {..}) = do
+    put codeStackSize
+    put codeMaxLocals
+    put codeLength
+    forM_ codeInstructions put
+    put codeExceptionsN
+    forM_ codeExceptions put
+    put codeAttrsN
+    forM_ codeAttributes put

 
   get = do
 
   get = do

-    end <- isEmpty
-    if end
-      then return $ Code []
-      else do
-           x <- get
-           (Code next) <- get
-           return $ Code (x: next)
+    stackSz <- get
+    locals <- get
+    len <- get
+    bytes <- replicateM (fromIntegral len) get
+    let bytecode = B.pack bytes
+        code = decodeWith readInstructions 0 bytecode
+    excn <- get
+    excs <- replicateM (fromIntegral excn) get
+    nAttrs <- get
+    attrs <- replicateM (fromIntegral nAttrs) get
+    return $ Code stackSz locals len code excn excs nAttrs attrs
+
+readInstructions :: GetState Integer [Instruction]
+readInstructions = do
+   end <- isEmpty
+   if end
+     then return []
+     else do
+          x <- get
+          next <- readInstructions
+          return (x: next)

 
 data Instruction =
     NOP            -- 0
 
 data Instruction =
     NOP            -- 0


@@ -173,8 +227,8 @@ data Instruction =
   | FCMP CMP               -- 149, 150
   | DCMP CMP               -- 151, 152
   | IF CMP                 -- 153, 154, 155, 156, 157, 158
   | FCMP CMP               -- 149, 150
   | DCMP CMP               -- 151, 152
   | IF CMP                 -- 153, 154, 155, 156, 157, 158

-  | IF_ACMP CMP Word16     -- 165, 166

   | IF_ICMP CMP Word16     -- 159, 160, 161, 162, 163, 164
   | IF_ICMP CMP Word16     -- 159, 160, 161, 162, 163, 164

+  | IF_ACMP CMP Word16     -- 165, 166

   | GOTO                   -- 167
   | JSR Word16             -- 168
   | RET                    -- 169
   | GOTO                   -- 167
   | JSR Word16             -- 168
   | RET                    -- 169

diff --git a/disassemble.hs b/disassemble.hs
index a11a2ad5ef29046b199856757c9da16993572154..fc6e77f4da9e04633af4aa2c27c06b0e478a825b 100644 (file)
--- a/disassemble.hs
+++ b/disassemble.hs
@@ -21,7 +21,9 @@ main = do
         B.putStrLn (methodName m)
         case attrByName m "Code" of
           Nothing -> putStrLn "(no code)\n"
         B.putStrLn (methodName m)
         case attrByName m "Code" of
           Nothing -> putStrLn "(no code)\n"

-          Just bytecode -> let (Code code) = decodeS (0 :: Integer) bytecode
-                           in  forM_ code print
+          Just bytecode -> let code = decodeS (0 :: Integer) bytecode
+                           in  forM_ (codeInstructions code) $ \i -> do
+                                 putStr "  "
+                                 print i

 
     _ -> error "Synopsis: disassemble File.class"
 
     _ -> error "Synopsis: disassemble File.class"