X-Git-Url: http://wien.tomnetworks.com/gitweb/?a=blobdiff_plain;f=JVM%2FAssembler.hs;h=6a10b3c0b626637a88f05ca9671ced7cd97de9ef;hb=ac5c22f4805f1e9849b08dd875b1654601123a23;hp=cc886ae807f50d59fd830a18bf46c9e4684b63e2;hpb=09a5e281d1f60a9484689a4c0cb302f645a535d3;p=hs-java.git diff --git a/JVM/Assembler.hs b/JVM/Assembler.hs index cc886ae..6a10b3c 100644 --- a/JVM/Assembler.hs +++ b/JVM/Assembler.hs @@ -9,16 +9,20 @@ module JVM.Assembler CodeException (..), Code (..), IMM (..), - CMP (..) + CMP (..), + atype2byte, + encodeInstructions, + encodeMethod, + decodeMethod ) where import Control.Monad import Control.Applicative +import Data.Ix (inRange) import Data.Word import qualified Data.Binary as Binary import qualified Data.ByteString.Lazy as B -import Data.Array import Data.BinaryState import JVM.ClassFile @@ -50,7 +54,7 @@ data Code = Code { codeExceptionsN :: Word16, codeExceptions :: [CodeException], codeAttrsN :: Word16, - codeAttributes :: [AttributeInfo] } + codeAttributes :: Attributes File } deriving (Eq, Show) -- | Exception descriptor @@ -70,7 +74,7 @@ instance BinaryState Integer CodeException where get = CodeException <$> get <*> get <*> get <*> get -instance BinaryState Integer AttributeInfo where +instance BinaryState Integer Attribute where put a = do let sz = 6 + attributeLength a -- full size of AttributeInfo structure liftOffset (fromIntegral sz) Binary.put a @@ -86,7 +90,7 @@ instance BinaryState Integer Code where put codeExceptionsN forM_ codeExceptions put put codeAttrsN - forM_ codeAttributes put + forM_ (attributesList codeAttributes) put get = do stackSz <- get @@ -99,7 +103,7 @@ instance BinaryState Integer Code where excs <- replicateM (fromIntegral excn) get nAttrs <- get attrs <- replicateM (fromIntegral nAttrs) get - return $ Code stackSz locals len code excn excs nAttrs attrs + return $ Code stackSz locals len code excn excs nAttrs (AP attrs) -- | Read sequence of instructions (to end of stream) readInstructions :: GetState Integer [Instruction] @@ -112,7 +116,7 @@ readInstructions = do next <- readInstructions return (x: next) --- | JVM instruction set +-- | JVM instruction set. For comments, see JVM specification. data Instruction = NOP -- ^ 0 | ACONST_NULL -- ^ 1 @@ -235,10 +239,10 @@ data Instruction = | LCMP -- ^ 148 | FCMP CMP -- ^ 149, 150 | DCMP CMP -- ^ 151, 152 - | IF CMP -- ^ 153, 154, 155, 156, 157, 158 + | IF CMP Word16 -- ^ 153, 154, 155, 156, 157, 158 | IF_ICMP CMP Word16 -- ^ 159, 160, 161, 162, 163, 164 | IF_ACMP CMP Word16 -- ^ 165, 166 - | GOTO -- ^ 167 + | GOTO Word16 -- ^ 167 | JSR Word16 -- ^ 168 | RET -- ^ 169 | TABLESWITCH Word32 Word32 Word32 [Word32] -- ^ 170 @@ -273,7 +277,7 @@ data Instruction = | JSR_W Word32 -- ^ 201 deriving (Eq, Show) --- ^ JVM array type (primitive types) +-- | JVM array type (primitive types) data ArrayType = T_BOOLEAN -- ^ 4 | T_CHAR -- ^ 5 @@ -285,14 +289,14 @@ data ArrayType = | T_LONG -- ^ 11 deriving (Eq, Show, Enum) --- ^ Parse opcode with immediate constant +-- | Parse opcode with immediate constant imm :: Word8 -- ^ Base opcode -> (IMM -> Instruction) -- ^ Instruction constructor -> Word8 -- ^ Opcode to parse -> GetState s Instruction imm base constr x = return $ constr $ toEnum $ fromIntegral (x-base) --- ^ Put opcode with immediate constant +-- | Put opcode with immediate constant putImm :: Word8 -- ^ Base opcode -> IMM -- ^ Constant to add to opcode -> PutState Integer () @@ -326,7 +330,7 @@ instance BinaryState Integer ArrayType where put t = putByte (atype2byte t) --- ^ Put opcode with one argument +-- | Put opcode with one argument put1 :: (BinaryState Integer a) => Word8 -- ^ Opcode -> a -- ^ First argument @@ -471,12 +475,12 @@ instance BinaryState Integer Instruction where put (DCMP C_LT) = putByte 151 put (DCMP C_GT) = putByte 152 put (DCMP c) = fail $ "No such instruction: DCMP " ++ show c - put (IF c) = putByte (fromIntegral $ 153 + fromEnum c) + put (IF c x) = putByte (fromIntegral $ 153 + fromEnum c) >> put x put (IF_ACMP C_EQ x) = put1 165 x put (IF_ACMP C_NE x) = put1 166 x put (IF_ACMP c _) = fail $ "No such instruction: IF_ACMP " ++ show c put (IF_ICMP c x) = putByte (fromIntegral $ 159 + fromEnum c) >> put x - put GOTO = putByte 167 + put (GOTO x) = put1 167 x put (JSR x) = put1 168 x put RET = putByte 169 put (TABLESWITCH def low high offs) = do @@ -642,7 +646,7 @@ instance BinaryState Integer Instruction where 152 -> return $ DCMP C_GT 165 -> IF_ACMP C_EQ <$> get 166 -> IF_ACMP C_NE <$> get - 167 -> return GOTO + 167 -> GOTO <$> get 168 -> JSR <$> get 169 -> return RET 170 -> do @@ -700,7 +704,21 @@ instance BinaryState Integer Instruction where | inRange (34, 37) c -> imm 34 FLOAD_ c | inRange (38, 41) c -> imm 38 DLOAD_ c | inRange (42, 45) c -> imm 42 ALOAD_ c - | inRange (153, 158) c -> return $ IF (toEnum $ fromIntegral $ c-153) + | inRange (153, 158) c -> IF (toEnum $ fromIntegral $ c-153) <$> get | inRange (159, 164) c -> IF_ICMP (toEnum $ fromIntegral $ c-159) <$> get | otherwise -> fail $ "Unknown instruction byte code: " ++ show c + +-- | Encode list of instructions +encodeInstructions :: [Instruction] -> B.ByteString +encodeInstructions code = + let p list = forM_ list put + in encodeWith p (0 :: Integer) code +-- | 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 +