X-Git-Url: http://wien.tomnetworks.com/gitweb/?a=blobdiff_plain;f=JVM%2FClassFile.hs;h=baac43660e6df9a2d007eae349d85af6aa9f736c;hb=09a5e281d1f60a9484689a4c0cb302f645a535d3;hp=0f8a18289dbb84a68540997e78008a88d02fd713;hpb=635ecf8528ab8c5b84b88e9ab82b170f1271c6b6;p=hs-java.git diff --git a/JVM/ClassFile.hs b/JVM/ClassFile.hs index 0f8a182..baac436 100644 --- a/JVM/ClassFile.hs +++ b/JVM/ClassFile.hs @@ -1,5 +1,17 @@ {-# LANGUAGE RecordWildCards, BangPatterns #-} -module JVM.ClassFile where +-- | This module declares (low-level) data types for Java .class files +-- structures, and Binary instances to read/write them. +module JVM.ClassFile + (ClassFile (..), + CpInfo (..), + FieldInfo (..), + MethodInfo (..), + AttributeInfo (..), + FieldType (..), + FieldSignature, MethodSignature (..), ReturnSignature (..), + ArgumentSignature (..) + ) + where import Control.Monad import Control.Applicative @@ -7,49 +19,37 @@ import Data.Binary import Data.Binary.IEEE754 import Data.Binary.Get import Data.Binary.Put -import Data.Word import Data.Char +import Data.List import qualified Data.ByteString.Lazy as B -import Debug.Trace - -traceS :: (Show a) => String -> a -> a -traceS msg x = trace (msg ++ ": " ++ show x) x - -char :: Word8 -> Char -char n = chr (fromIntegral n) - +-- | Read one-byte Char getChar8 :: Get Char getChar8 = do x <- getWord8 - return (char x) + return $ chr (fromIntegral x) +-- | Generic .class file format data ClassFile = ClassFile { - magic :: Word32, + magic :: Word32, -- ^ Magic value: 0xCAFEBABE minorVersion :: Word16, majorVersion :: Word16, - constsPoolSize :: Word16, - constsPool :: [CpInfo], - accessFlags :: Word16, - thisClass :: Word16, - superClass :: Word16, - interfacesCount :: Word16, - interfaces :: [Word16], - classFieldsCount :: Word16, - classFields :: [FieldInfo], - classMethodsCount :: Word16, - classMethods :: [MethodInfo], - classAttributesCount :: Word16, - classAttributes :: [AttributeInfo] + constsPoolSize :: Word16, -- ^ Number of items in constants pool + constsPool :: [CpInfo], -- ^ Constants pool itself + accessFlags :: Word16, -- ^ See @JVM.Types.AccessFlag@ + thisClass :: Word16, -- ^ Constants pool item index for this class + superClass :: Word16, -- ^ --/-- for super class, zero for java.lang.Object + interfacesCount :: Word16, -- ^ Number of implemented interfaces + interfaces :: [Word16], -- ^ Constants pool item indexes for implemented interfaces + classFieldsCount :: Word16, -- ^ Number of class fileds + classFields :: [FieldInfo], -- ^ Class fields + classMethodsCount :: Word16, -- ^ Number of class methods + classMethods :: [MethodInfo], -- ^ Class methods + classAttributesCount :: Word16, -- ^ Number of class attributes + classAttributes :: [AttributeInfo] -- ^ Class attributes } deriving (Eq, Show) -traceM msg x = do - r <- x - return $ traceS msg r - -replicateMT n m = replicateM n (traceM ">" m) - instance Binary ClassFile where put (ClassFile {..}) = do put magic @@ -89,21 +89,37 @@ instance Binary ClassFile where return $ ClassFile magic minor major poolsize pool af this super interfacesCount ifaces classFieldsCount classFields classMethodsCount classMethods asCount as +-- | Field signature format data FieldType = - SignedByte -- B - | CharByte -- C - | DoubleType -- D - | FloatType -- F - | IntType -- I - | LongInt -- J - | ShortInt -- S - | BoolType -- Z - | ObjectType String -- L - | Array (Maybe Int) FieldType - deriving (Eq, Show) - + SignedByte -- ^ B + | CharByte -- ^ C + | DoubleType -- ^ D + | FloatType -- ^ F + | IntType -- ^ I + | LongInt -- ^ J + | ShortInt -- ^ S + | BoolType -- ^ Z + | ObjectType String -- ^ L @{class name}@ + | Array (Maybe Int) FieldType -- ^ @[{type}@ + deriving (Eq) + +instance Show FieldType where + show SignedByte = "byte" + show CharByte = "char" + show DoubleType = "double" + show FloatType = "float" + show IntType = "int" + show LongInt = "long" + show ShortInt = "short" + show BoolType = "bool" + show (ObjectType s) = "Object " ++ s + show (Array Nothing t) = show t ++ "[]" + show (Array (Just n) t) = show t ++ "[" ++ show n ++ "]" + +-- | Class field signature type FieldSignature = FieldType +-- | Try to read integer value from decimal representation getInt :: Get (Maybe Int) getInt = do s <- getDigits @@ -154,6 +170,7 @@ instance Binary FieldType where return (Array mbSize sig) _ -> fail $ "Unknown signature opening symbol: " ++ [b] +-- | Read string up to `;' getToSemicolon :: Get String getToSemicolon = do x <- get @@ -163,10 +180,15 @@ getToSemicolon = do next <- getToSemicolon return (x: next) +-- | Return value signature data ReturnSignature = Returns FieldType | ReturnsVoid - deriving (Eq, Show) + deriving (Eq) + +instance Show ReturnSignature where + show (Returns t) = show t + show ReturnsVoid = "Void" instance Binary ReturnSignature where put (Returns sig) = put sig @@ -178,11 +200,16 @@ instance Binary ReturnSignature where 'V' -> skip 1 >> return ReturnsVoid _ -> Returns <$> get +-- | Method argument signature type ArgumentSignature = FieldType +-- | Class method argument signature data MethodSignature = MethodSignature [ArgumentSignature] ReturnSignature - deriving (Eq, Show) + deriving (Eq) + +instance Show MethodSignature where + show (MethodSignature args ret) = "(" ++ intercalate ", " (map show args) ++ ") returns " ++ show ret instance Binary MethodSignature where put (MethodSignature args ret) = do @@ -202,6 +229,7 @@ instance Binary MethodSignature where ret <- get return (MethodSignature args ret) +-- | Read arguments signatures (up to `)') getArgs :: Get [ArgumentSignature] getArgs = whileJust getArg where @@ -221,19 +249,20 @@ whileJust m = do return (x: next) Nothing -> return [] +-- | Constant pool item format data CpInfo = - CONSTANT_Class {nameIndex :: Word16} -- 7 - | CONSTANT_Fieldref {classIndex :: Word16, nameAndTypeIndex :: Word16} -- 9 - | CONSTANT_Methodref {classIndex :: Word16, nameAndTypeIndex :: Word16} -- 10 - | CONSTANT_InterfaceMethodref {classIndex :: Word16, nameAndTypeIndex :: Word16}-- 11 - | CONSTANT_String {stringIndex :: Word16} -- 8 - | CONSTANT_Integer {fourBytes :: Word32} -- 3 - | CONSTANT_Float Float -- 4 - | CONSTANT_Long Word64 -- 5 - | CONSTANT_Double Double -- 6 - | CONSTANT_NameAndType {nameIndex :: Word16, signatureIndex :: Word16} -- 12 - | CONSTANT_Utf8 {stringLength :: Word16, stringBytes :: B.ByteString} -- 1 - | CONSTANT_Unicode {stringLength :: Word16, stringBytes :: B.ByteString} -- 2 + CONSTANT_Class {nameIndex :: Word16} -- ^ 7 + | CONSTANT_Fieldref {classIndex :: Word16, nameAndTypeIndex :: Word16} -- ^ 9 + | CONSTANT_Methodref {classIndex :: Word16, nameAndTypeIndex :: Word16} -- ^ 10 + | CONSTANT_InterfaceMethodref {classIndex :: Word16, nameAndTypeIndex :: Word16}-- ^ 11 + | CONSTANT_String {stringIndex :: Word16} -- ^ 8 + | CONSTANT_Integer {fourBytes :: Word32} -- ^ 3 + | CONSTANT_Float Float -- ^ 4 + | CONSTANT_Long Word64 -- ^ 5 + | CONSTANT_Double Double -- ^ 6 + | CONSTANT_NameAndType {nameIndex :: Word16, signatureIndex :: Word16} -- ^ 12 + | CONSTANT_Utf8 {stringLength :: Word16, stringBytes :: B.ByteString} -- ^ 1 + | CONSTANT_Unicode {stringLength :: Word16, stringBytes :: B.ByteString} -- ^ 2 deriving (Eq, Show) instance Binary CpInfo where @@ -274,6 +303,7 @@ instance Binary CpInfo where 12 -> CONSTANT_NameAndType <$> get <*> get _ -> fail $ "Unknown constants pool entry tag: " ++ show tag +-- | Class field format data FieldInfo = FieldInfo { fieldAccessFlags :: Word16, fieldNameIndex :: Word16, @@ -298,6 +328,7 @@ instance Binary FieldInfo where as <- replicateM (fromIntegral n) get return $ FieldInfo af ni si n as +-- | Class method format data MethodInfo = MethodInfo { methodAccessFlags :: Word16, methodNameIndex :: Word16, @@ -323,6 +354,8 @@ instance Binary MethodInfo where as <- replicateM (fromIntegral n) get return $ MethodInfo af ni si n as +-- | Any (class/ field/ method/ ...) attribute format. +-- Some formats specify special formats for @attributeValue@. data AttributeInfo = AttributeInfo { attributeName :: Word16, attributeLength :: Word32,