1 {-# LANGUAGE RecordWildCards, BangPatterns #-}
2 -- | This module declares (low-level) data types for Java .class files
3 -- structures, and Binary instances to read/write them.
11 FieldSignature, MethodSignature (..), ReturnSignature (..)
16 import Control.Applicative
18 import Data.Binary.IEEE754
19 import Data.Binary.Get
20 import Data.Binary.Put
24 import qualified Data.ByteString.Lazy as B
26 -- | Read one-byte Char
30 return $ chr (fromIntegral x)
32 -- | Generic .class file format
33 data ClassFile = ClassFile {
34 magic :: Word32, -- ^ Magic value: 0xCAFEBABE
35 minorVersion :: Word16,
36 majorVersion :: Word16,
37 constsPoolSize :: Word16, -- ^ Number of items in constants pool
38 constsPool :: [CpInfo], -- ^ Constants pool itself
39 accessFlags :: Word16, -- ^ See @JVM.Types.AccessFlag@
40 thisClass :: Word16, -- ^ Constants pool item index for this class
41 superClass :: Word16, -- ^ --/-- for super class, zero for java.lang.Object
42 interfacesCount :: Word16, -- ^ Number of implemented interfaces
43 interfaces :: [Word16], -- ^ Constants pool item indexes for implemented interfaces
44 classFieldsCount :: Word16, -- ^ Number of class fileds
45 classFields :: [FieldInfo], -- ^ Class fields
46 classMethodsCount :: Word16, -- ^ Number of class methods
47 classMethods :: [MethodInfo], -- ^ Class methods
48 classAttributesCount :: Word16, -- ^ Number of class attributes
49 classAttributes :: [AttributeInfo] -- ^ Class attributes
53 instance Binary ClassFile where
54 put (ClassFile {..}) = do
68 forM_ classMethods put
69 put classAttributesCount
70 forM_ classAttributes put
77 pool <- replicateM (fromIntegral poolsize - 1) get
81 interfacesCount <- get
82 ifaces <- replicateM (fromIntegral interfacesCount) get
83 classFieldsCount <- get
84 classFields <- replicateM (fromIntegral classFieldsCount) get
85 classMethodsCount <- get
86 classMethods <- replicateM (fromIntegral classMethodsCount) get
88 as <- replicateM (fromIntegral $ asCount - 1) get
89 return $ ClassFile magic minor major poolsize pool af this super
90 interfacesCount ifaces classFieldsCount classFields classMethodsCount classMethods asCount as
92 -- | Field signature format
102 | ObjectType String -- ^ L <class name>
103 | Array (Maybe Int) FieldType -- ^ [<type>
106 instance Show FieldType where
107 show SignedByte = "byte"
108 show CharByte = "char"
109 show DoubleType = "double"
110 show FloatType = "float"
112 show LongInt = "long"
113 show ShortInt = "short"
114 show BoolType = "bool"
115 show (ObjectType s) = "Object " ++ s
116 show (Array Nothing t) = show t ++ "[]"
117 show (Array (Just n) t) = show t ++ "[" ++ show n ++ "]"
119 -- | Class field signature
120 type FieldSignature = FieldType
122 -- | Try to read integer value from decimal representation
123 getInt :: Get (Maybe Int)
128 else return $ Just (read s)
130 getDigits :: Get [Char]
132 c <- lookAhead getChar8
140 instance Binary FieldType where
141 put SignedByte = put 'B'
142 put CharByte = put 'C'
143 put DoubleType = put 'D'
144 put FloatType = put 'F'
145 put IntType = put 'I'
146 put LongInt = put 'J'
147 put ShortInt = put 'S'
148 put BoolType = put 'Z'
149 put (ObjectType name) = put 'L' >> put name
150 put (Array Nothing sig) = put '[' >> put sig
151 put (Array (Just n) sig) = put '[' >> put (show n) >> put sig
156 'B' -> return SignedByte
157 'C' -> return CharByte
158 'D' -> return DoubleType
159 'F' -> return FloatType
160 'I' -> return IntType
161 'J' -> return LongInt
162 'S' -> return ShortInt
163 'Z' -> return BoolType
165 name <- getToSemicolon
166 return (ObjectType name)
170 return (Array mbSize sig)
171 _ -> fail $ "Unknown signature opening symbol: " ++ [b]
173 -- | Read string up to `;'
174 getToSemicolon :: Get String
180 next <- getToSemicolon
183 -- | Return value signature
184 data ReturnSignature =
189 instance Show ReturnSignature where
190 show (Returns t) = show t
191 show ReturnsVoid = "Void"
193 instance Binary ReturnSignature where
194 put (Returns sig) = put sig
195 put ReturnsVoid = put 'V'
198 x <- lookAhead getChar8
200 'V' -> skip 1 >> return ReturnsVoid
203 -- | Method argument signature
204 type ArgumentSignature = FieldType
206 -- | Class method argument signature
207 data MethodSignature =
208 MethodSignature [ArgumentSignature] ReturnSignature
211 instance Show MethodSignature where
212 show (MethodSignature args ret) = "(" ++ intercalate ", " (map show args) ++ ") returns " ++ show ret
214 instance Binary MethodSignature where
215 put (MethodSignature args ret) = do
224 fail "Cannot parse method signature: no starting `(' !"
228 fail "Internal error: method signature without `)' !?"
230 return (MethodSignature args ret)
232 -- | Read arguments signatures (up to `)')
233 getArgs :: Get [ArgumentSignature]
234 getArgs = whileJust getArg
236 getArg :: Get (Maybe ArgumentSignature)
238 x <- lookAhead getChar8
243 whileJust :: (Monad m) => m (Maybe a) -> m [a]
252 -- | Constant pool item format
254 CONSTANT_Class {nameIndex :: Word16} -- ^ 7
255 | CONSTANT_Fieldref {classIndex :: Word16, nameAndTypeIndex :: Word16} -- ^ 9
256 | CONSTANT_Methodref {classIndex :: Word16, nameAndTypeIndex :: Word16} -- ^ 10
257 | CONSTANT_InterfaceMethodref {classIndex :: Word16, nameAndTypeIndex :: Word16}-- ^ 11
258 | CONSTANT_String {stringIndex :: Word16} -- ^ 8
259 | CONSTANT_Integer {fourBytes :: Word32} -- ^ 3
260 | CONSTANT_Float Float -- ^ 4
261 | CONSTANT_Long Word64 -- ^ 5
262 | CONSTANT_Double Double -- ^ 6
263 | CONSTANT_NameAndType {nameIndex :: Word16, signatureIndex :: Word16} -- ^ 12
264 | CONSTANT_Utf8 {stringLength :: Word16, stringBytes :: B.ByteString} -- ^ 1
265 | CONSTANT_Unicode {stringLength :: Word16, stringBytes :: B.ByteString} -- ^ 2
268 instance Binary CpInfo where
269 put (CONSTANT_Class i) = putWord8 7 >> put i
270 put (CONSTANT_Fieldref i j) = putWord8 9 >> put i >> put j
271 put (CONSTANT_Methodref i j) = putWord8 10 >> put i >> put j
272 put (CONSTANT_InterfaceMethodref i j) = putWord8 11 >> put i >> put j
273 put (CONSTANT_String i) = putWord8 8 >> put i
274 put (CONSTANT_Integer x) = putWord8 3 >> put x
275 put (CONSTANT_Float x) = putWord8 4 >> putFloat32be x
276 put (CONSTANT_Long x) = putWord8 5 >> put x
277 put (CONSTANT_Double x) = putWord8 6 >> putFloat64be x
278 put (CONSTANT_NameAndType i j) = putWord8 12 >> put i >> put j
279 put (CONSTANT_Utf8 l bs) = putWord8 1 >> put l >> putLazyByteString bs
280 put (CONSTANT_Unicode l bs) = putWord8 2 >> put l >> putLazyByteString bs
288 bs <- getLazyByteString (fromIntegral l)
289 return $ CONSTANT_Utf8 l bs
292 bs <- getLazyByteString (fromIntegral l)
293 return $ CONSTANT_Unicode l bs
294 3 -> CONSTANT_Integer <$> get
295 4 -> CONSTANT_Float <$> getFloat32be
296 5 -> CONSTANT_Long <$> get
297 6 -> CONSTANT_Double <$> getFloat64be
298 7 -> CONSTANT_Class <$> get
299 8 -> CONSTANT_String <$> get
300 9 -> CONSTANT_Fieldref <$> get <*> get
301 10 -> CONSTANT_Methodref <$> get <*> get
302 11 -> CONSTANT_InterfaceMethodref <$> get <*> get
303 12 -> CONSTANT_NameAndType <$> get <*> get
304 _ -> fail $ "Unknown constants pool entry tag: " ++ show tag
306 -- | Class field format
307 data FieldInfo = FieldInfo {
308 fieldAccessFlags :: Word16,
309 fieldNameIndex :: Word16,
310 fieldSignatureIndex :: Word16,
311 fieldAttributesCount :: Word16,
312 fieldAttributes :: [AttributeInfo] }
315 instance Binary FieldInfo where
316 put (FieldInfo {..}) = do
319 put fieldSignatureIndex
320 put fieldAttributesCount
321 forM_ fieldAttributes put
328 as <- replicateM (fromIntegral n) get
329 return $ FieldInfo af ni si n as
331 -- | Class method format
332 data MethodInfo = MethodInfo {
333 methodAccessFlags :: Word16,
334 methodNameIndex :: Word16,
335 methodSignatureIndex :: Word16,
336 methodAttributesCount :: Word16,
337 methodAttributes :: [AttributeInfo] }
340 instance Binary MethodInfo where
341 put (MethodInfo {..}) = do
342 put methodAccessFlags
344 put methodSignatureIndex
345 put methodAttributesCount
346 forM_ methodAttributes put
354 as <- replicateM (fromIntegral n) get
355 return $ MethodInfo af ni si n as
357 -- | Any (class/ field/ method/ ...) attribute format.
358 -- Some formats specify special formats for @attributeValue@.
359 data AttributeInfo = AttributeInfo {
360 attributeName :: Word16,
361 attributeLength :: Word32,
362 attributeValue :: B.ByteString }
365 instance Binary AttributeInfo where
366 put (AttributeInfo {..}) = do
368 putWord32be attributeLength
369 putLazyByteString attributeValue
375 value <- getLazyByteString (fromIntegral len)
376 return $ AttributeInfo name len value