diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,30 @@ +Copyright (c)2011, Carlos Gomez + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above + copyright notice, this list of conditions and the following + disclaimer in the documentation and/or other materials provided + with the distribution. + + * Neither the name of Carlos Gomez nor the names of other + contributors may be used to endorse or promote products derived + from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/README b/README new file mode 100644 --- /dev/null +++ b/README @@ -0,0 +1,20 @@ + +dbjava, decompiler of bytecodes of the jvm + +To Compile: + cabal install + + or + + runhaskell Setup.hs configure + runhaskell Setup.hs build + runhaskell Setup.hs install + +To Run: + + dbjava namefile.class + +You can also see the examples con src. + +Carlos Gomez, carliros.g@gmail.com + diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,6 @@ + +import Distribution.Simple + +main :: IO() +main = defaultMain + diff --git a/dbjava.cabal b/dbjava.cabal new file mode 100644 --- /dev/null +++ b/dbjava.cabal @@ -0,0 +1,35 @@ +Name: dbjava +Version: 1.7 +Author: Carlos Gomez +Homepage: http://devel.comunidadhaskell.org/dbjava/ +Description: A serializer and deserializer of Jvm classfile format. +Synopsis: Decompiler Bytecode Java +License: BSD3 +License-file: LICENSE +Category: Jvm +Maintainer: carliros.g@gmail.com +Build-Type: Simple +Cabal-Version: >=1.2 +Extra-source-files: README, LICENSE , src/test1.hs, src/test2.hs + +Executable dbjava + Hs-source-dirs: src + Main-is: Main.hs + Build-Depends: base >= 3 && < 5, + binary, + bytestring, + uulib, + process, + haskell98 + +Library + Hs-source-dirs: src + Build-Depends: base >= 3 && < 5, + binary, + bytestring, + uulib, + process, + haskell98 + Exposed-modules: Jvm.Data.ClassFormat, + Jvm.BinaryClass, + Jvm.PrettyClass diff --git a/src/Jvm/BinaryClass.hs b/src/Jvm/BinaryClass.hs new file mode 100644 --- /dev/null +++ b/src/Jvm/BinaryClass.hs @@ -0,0 +1,518 @@ +module Jvm.BinaryClass where +import Jvm.Data.ClassFormat + +import Data.Binary +import Data.Binary.Get +import Data.Binary.Put +import qualified Data.ByteString.Lazy as BS +import Control.Monad +import Data.Word +import Data.Int +import Data.Bits + +instance Binary ClassFile where + put (ClassFile mg mnv mjv tam_cp lst_cp flgs ths spr tam_if lst_if tam_fd lst_fd tam_mth lst_mth tam_attr lst_attr) + = put mg >> + put mnv >> + put mjv >> + put (fromInt2Word16 tam_cp) >> + mapM_ put lst_cp >> + put flgs >> + put ths >> + put spr >> + put (fromInt2Word16 tam_if) >> + mapM_ put lst_if >> + put (fromInt2Word16 tam_fd) >> + mapM_ put lst_fd >> + put (fromInt2Word16 tam_mth) >> + mapM_ put lst_mth >> + put (fromInt2Word16 tam_attr) >> + mapM_ put lst_attr + + -- el tamanio del constant_pool = 1 + length(constant_pool) + get = do mg <- get :: Get Magic + mnv <- get :: Get MinorVersion + mjv <- get :: Get MajorVersion + wtam_cp <- getWord16 + let tam_cp = fromWord162Int wtam_cp + lst_cp <- getMany $ tam_cp-1 + flgs <- get :: Get AccessFlags + ths <- get :: Get ThisClass + spr <- get :: Get SuperClass + wtam_if <- getWord16 + let tam_if = fromWord162Int wtam_if + lst_if <- getMany tam_if + wtam_fd <- getWord16 + let tam_fd = fromWord162Int wtam_fd + lst_fd <- getMany tam_fd + wtam_mth <- getWord16 + let tam_mth = fromWord162Int wtam_mth + lst_mth <- getMany tam_mth + wtam_attr <- getWord16 + let tam_attr = fromWord162Int wtam_attr + lst_attr <- getMany tam_attr + return $ ClassFile mg mnv mjv tam_cp lst_cp flgs ths spr tam_if lst_if tam_fd lst_fd tam_mth lst_mth tam_attr lst_attr + + + +instance Binary Magic where + put (Magic) = put (202::Word8) >> put (254::Word8) >> put (186::Word8) >> put (190::Word8) + get = do ca <- getWord8 + fe <- getWord8 + ba <- getWord8 + be <- getWord8 + return Magic + +instance Binary MinorVersion where + put (MinorVersion i) + = put $ fromInt2Word16 i + get = do str <- getWord16 + return $ MinorVersion $ fromWord162Int str + +instance Binary MajorVersion where + put (MajorVersion i) = put $ fromInt2Word16 i + get = do str <- getWord16 + return $ MajorVersion $ fromWord162Int str + +instance Binary CP_Info where + put (Class_Info tag_cp index_cp str) + = put tag_cp >> put (fromInt2Word16 index_cp) + put (FieldRef_Info tag_cp index_name_cp index_nameandtype_cp str) + = put tag_cp >> put (fromInt2Word16 index_name_cp) >> put (fromInt2Word16 index_nameandtype_cp) + put (MethodRef_Info tag_cp index_name_cp index_nameandtype_cp _) + = put tag_cp >> put (fromInt2Word16 index_name_cp) >> put (fromInt2Word16 index_nameandtype_cp) + put (InterfaceMethodRef_Info tag_cp index_name_cp index_nameandtype_cp _) + = put tag_cp >> put (fromInt2Word16 index_name_cp) >> put (fromInt2Word16 index_nameandtype_cp) + put (String_Info tag_cp index_cp _) + = put tag_cp >> put (fromInt2Word16 index_cp) + put (Integer_Info tag_cp numi_cp _) + = put tag_cp >> put (fromInt2Word32 numi_cp) + put (Float_Info tag_cp numf_cp _) + = put tag_cp >> put (fromFloat2Word32 numf_cp) + put (Long_Info tag_cp numi_l1_cp numi_l2_cp _) + = put tag_cp >> put (fromInt2Word32 numi_l1_cp) >> put (fromInt2Word32 numi_l2_cp) + put (Double_Info tag_cp numi_d1_cp numi_d2_cp _) + = put tag_cp >> put (fromInt2Word32 numi_d1_cp) >> put (fromInt2Word32 numi_d2_cp) + put (NameAndType_Info tag_cp index_name_cp index_descr_cp _) + = put tag_cp >> put (fromInt2Word16 index_name_cp) >> put (fromInt2Word16 index_descr_cp) + put (Utf8_Info tag_cp tam_cp cad_cp _) + = put tag_cp >> put (fromInt2Word16 tam_cp) >> mapM_ put cad_cp + + get = do tag <- get :: Get Tag + case tag of + TagClass + -> do wind <- getWord16 + let ind = fromWord162Int wind + return $ Class_Info tag ind "" + TagFieldRef + -> do wind1 <- getWord16 + wind2 <- getWord16 + let ind1 = fromWord162Int wind1 + ind2 = fromWord162Int wind2 + return $ FieldRef_Info tag ind1 ind2 "" + TagMethodRef + -> do wind1 <- getWord16 + wind2 <- getWord16 + let ind1 = fromWord162Int wind1 + ind2 = fromWord162Int wind2 + return $ MethodRef_Info tag ind1 ind2 "" + TagInterfaceMethodRef + -> do wind1 <- getWord16 + wind2 <- getWord16 + let ind1 = fromWord162Int wind1 + ind2 = fromWord162Int wind2 + return $ InterfaceMethodRef_Info tag ind1 ind2 "" + TagString + -> do wind <- getWord16 + let ind = fromWord162Int wind + return $ String_Info tag ind "" + TagInteger + -> do wnum <- getWord32 + let num = fromWord322Int wnum + return $ Integer_Info tag num "" + TagFloat + -> do wnum <- getWord32 + let num = fromWord322Float wnum + return $ Float_Info tag num "" + TagLong + -> do wnum1 <- getWord32 + wnum2 <- getWord32 + let num1 = fromWord322Int wnum1 + num2 = fromWord322Int wnum2 + return $ Long_Info tag num1 num2 "" + TagDouble + -> do wnum1 <- getWord32 + wnum2 <- getWord32 + let num1 = fromWord322Int wnum1 + num2 = fromWord322Int wnum2 + return $ Double_Info tag num1 num2 "" + TagNameAndType + -> do wnum1 <- getWord16 + wnum2 <- getWord16 + let num1 = fromWord162Int wnum1 + num2 = fromWord162Int wnum2 + return $ NameAndType_Info tag num1 num2 "" + TagUtf8 + -> do wnum <- getWord16 + let num = fromWord162Int wnum + lst <- getMany num + return $ Utf8_Info tag num lst "" + +instance Binary Tag where + put (TagClass) = put (7 ::Word8) + put (TagFieldRef) = put (9 ::Word8) + put (TagMethodRef) = put (10::Word8) + put (TagInterfaceMethodRef) = put (11::Word8) + put (TagString) = put (8 ::Word8) + put (TagInteger) = put (3 ::Word8) + put (TagFloat) = put (4 ::Word8) + put (TagLong) = put (5 ::Word8) + put (TagDouble) = put (6 ::Word8) + put (TagNameAndType) = put (12::Word8) + put (TagUtf8) = put (1 ::Word8) + get = do num <- get::Get Word8 + let val = fromWord82Int num + let tag = case val of + 7 -> TagClass + 9 -> TagFieldRef + 10 -> TagMethodRef + 11 -> TagInterfaceMethodRef + 8 -> TagString + 3 -> TagInteger + 4 -> TagFloat + 5 -> TagLong + 6 -> TagDouble + 12 -> TagNameAndType + 1 -> TagUtf8 + _ -> error $ "Error: Unknow Tag " ++ show val + return tag + +instance Binary AccessFlags where + put (AccessFlags lst) = do + let flag = if null lst + then 0 + else foldl1 (.+.) lst + put $ fromInt2Word16 flag + get = do wmask <- getWord16 + let mask = fromWord162Int wmask + lst = filter (bitsSet mask) [ acc_Public + , acc_Private + , acc_Protected + , acc_Static + , acc_Final + , acc_Super_Synchronized + , acc_Volatile_Bridge + , acc_Transient_Varargs + , acc_Native + , acc_Interface + , acc_Abstract + , acc_Strict + , acc_Synthetic + , acc_Annotation + , acc_Enum] + return $ AccessFlags lst + +instance Binary ThisClass where + put (ThisClass i) = put $ fromInt2Word16 i + get = do wnum <- get :: Get Word16 + let num = fromWord162Int wnum + return $ ThisClass num + +instance Binary SuperClass where + put (SuperClass i) = put $ fromInt2Word16 i + get = do wnum <- get :: Get Word16 + let num = fromWord162Int wnum + return $ SuperClass num + +instance Binary Interface where + put (Interface i) = put $ fromInt2Word16 i + get = do wiif <- get :: Get Word16 + let iif = fromWord162Int wiif + return $ Interface iif + +instance Binary Field_Info where + put (Field_Info accs inam idsr tam lst_attr) + = put accs >> put (fromInt2Word16 inam) >> put (fromInt2Word16 idsr) >> put (fromInt2Word16 tam) >> mapM_ put lst_attr + get = do accs <- get :: Get AccessFlags + winam <- getWord16 + widsr <- getWord16 + wtam <- getWord16 + let inam = fromWord162Int winam + let idsr = fromWord162Int widsr + let tam_attr = fromWord162Int wtam + lst_attr <- getMany tam_attr + return $ Field_Info accs inam idsr tam_attr lst_attr + +instance Binary Method_Info where + put (Method_Info accs inam idsr tam_attr lst_attr) + = put accs >> put (fromInt2Word16 inam) >> put (fromInt2Word16 idsr) >> put (fromInt2Word16 tam_attr) >> mapM_ put lst_attr + get = do accs <- get :: Get AccessFlags + winam <- getWord16 + widsr <- getWord16 + wtam <- getWord16 + let inam = fromWord162Int winam + let idsr = fromWord162Int widsr + let tam_attr = fromWord162Int wtam + lst_attr <- getMany tam_attr + return $ Method_Info accs inam idsr tam_attr lst_attr + +instance Binary Attribute_Info where + put (AttributeGeneric inam tam_all rest_attr) + = put (fromInt2Word16 inam) >> put (fromInt2Word32 tam_all) >> putLazyByteString rest_attr --error "Invalid Attribute, Class Error" + + put (AttributeConstantValue inam tam_all ival) + = put (fromInt2Word16 inam) >> put (fromInt2Word32 tam_all ) >> put (fromInt2Word16 ival) + + put (AttributeCode inam tam_all mlen_stack mlen_local tam_code lst_code tam_ex lst_ex tam_attr lst_attr) + = put (fromInt2Word16 inam) >> + put (fromInt2Word32 tam_all) >> + put (fromInt2Word16 mlen_stack) >> + put (fromInt2Word16 mlen_local) >> + put (fromInt2Word32 tam_code) >> + mapM_ (\cod -> putWord8 (fromInt2Word8 cod)) lst_code >> + put (fromInt2Word16 tam_ex) >> + mapM_ (\(e1,e2,e3,e4) -> put (fromInt2Word16 e1) >> put (fromInt2Word16 e2) >> put (fromInt2Word16 e3) >> put (fromInt2Word16 e4)) lst_ex >> + put (fromInt2Word16 tam_attr) >> + mapM_ put lst_attr + + put (AttributeExceptions inam tam_all tam_num_ex lst_ex) + = put (fromInt2Word16 inam) >> + put (fromInt2Word32 tam_all) >> + put (fromInt2Word16 tam_num_ex) >> + mapM_ (\ind -> putWord8 (fromInt2Word8 ind)) lst_ex + + put (AttributeInnerClasses inam tam_all tam_classes lst_classes) + = put (fromInt2Word16 inam) >> + put (fromInt2Word32 tam_all) >> + put (fromInt2Word16 tam_classes) >> + mapM_ (\(incl,outcl,innm,inflg) -> put (fromInt2Word16 incl) >> + put (fromInt2Word16 outcl) >> + put (fromInt2Word16 innm) >> + put inflg) lst_classes + + put (AttributeSynthetic inam tam_all) + = put (fromInt2Word16 inam) >> + put (fromInt2Word32 tam_all) + + put (AttributeSourceFile inam tam_all ind_src) + = put (fromInt2Word16 inam) >> put (fromInt2Word32 tam_all) >> put (fromInt2Word16 ind_src) + + put (AttributeLineNumberTable inam tam_all tam_table lst_line) + = put (fromInt2Word16 inam) >> + put (fromInt2Word32 tam_all) >> + put (fromInt2Word16 tam_table) >> + mapM_ (\(e1,e2) -> put (fromInt2Word16 e1) >> put (fromInt2Word16 e2)) lst_line + + put (AttributeLocalVariableTable inam tam_all tam_var lst_var) + = put (fromInt2Word16 inam) >> + put (fromInt2Word32 tam_all) >> + put (fromInt2Word16 tam_var) >> + mapM_ (\(e1,e2,e3,e4,e5) -> put (fromInt2Word16 e1) >> put (fromInt2Word16 e2) >> put (fromInt2Word16 e3) >> put (fromInt2Word16 e4) >> put (fromInt2Word16 e5)) lst_var + + put (AttributeDeprecated inam tam_all) + = put (fromInt2Word16 inam) >> + put (fromInt2Word32 tam_all) + + get = do winam <- getWord16 + wtam_all <- getWord32 + let inam = fromWord162Int winam + tam_all = fromWord322Int wtam_all + rest_attr <- getLazyByteString $ toInt64 tam_all + return $ AttributeGeneric inam tam_all rest_attr + +type Tupla5Int = [(Int, Int, Int, Int, Int)] +type Tupla2Int = [(Int, Int)] +type Tupla4Int = [(Int, Int, Int, Int)] +type ListaInt = [Int] +type ConstantPool_Count = Int +type Interfaces_Count = Int +type Fields_Count = Int +type Methods_Count = Int +type Attributes_Count = Int +type Index_Constant_Pool = Int + + +-- auxiliar functions +infixl 5 .+. +(.+.) :: Int -> Int -> Int +a .+. b = a .|. b + +bitsSet :: Int -> Int -> Bool +bitsSet mask i + = (mask .&. i == i) + +toInt64 :: Int -> Int64 +toInt64 = read.show + +getWord16 = get :: Get Word16 +getWord32 = get :: Get Word32 + +fromWord162Int :: Word16 -> Int +fromWord162Int = read.show + +fromWord82Int :: Word8 -> Int +fromWord82Int = read.show + +fromWord322Int :: Word32 -> Int +fromWord322Int = read.show + +fromWord322Float :: Word32 -> Float +fromWord322Float = read.show + +fromInt2Word8 :: Int -> Word8 +fromInt2Word8 = read.show + +fromInt2Word16 :: Int -> Word16 +fromInt2Word16 = read.show + +fromInt2Word32 :: Int -> Word32 +fromInt2Word32 = read.show + +fromFloat2Word32 :: Float -> Word32 +fromFloat2Word32 = read.show + +getMany :: Binary a => Int -> Get [a] +getMany n = go [] n + where + go xs 0 = return $! reverse xs + go xs i = do x <- get + x `seq` go (x:xs) (i-1) -- we must seq x to avoid stack overflows due to laziness in (>>=) + +-- functions to modify attributes +getListAttr cp_infos 0 str = ([],str,toInt64 0) +getListAttr cp_infos n str + = let (winam,rs1,n1) = runGetState (get :: Get Word16) str (toInt64 0) + inam = fromWord162Int winam + (wtam,rs2,n2) = runGetState (get :: Get Word32) rs1 (toInt64 0) + tam = fromWord322Int wtam + (rest,rs3,n3) = runGetState (getLazyByteString (toInt64 tam)) rs2 (toInt64 0) + attr_generic = AttributeGeneric inam tam rest + attr_specific = fChgAttr cp_infos attr_generic + in let (lstn, rsn, nn) = getListAttr cp_infos (n-1) rs3 in (attr_specific : lstn, rsn, nn) + +getListExCod 0 str = ([],str) +getListExCod n str + = let (wstart_pc , rs1, n1) = runGetState (get :: Get Word16) str (toInt64 0) + (wend_pc , rs2, n2) = runGetState (get :: Get Word16) rs1 (toInt64 0) + (whandler_pc, rs3, n3) = runGetState (get :: Get Word16) rs2 (toInt64 0) + (wcatch_type, rs4, n4) = runGetState (get :: Get Word16) rs3 (toInt64 0) + start_pc = fromWord162Int wstart_pc + end_pc = fromWord162Int wend_pc + handler_pc = fromWord162Int whandler_pc + catch_type = fromWord162Int wcatch_type + in let (lst, r) = getListExCod (n-1) rs4 in ((start_pc,end_pc,handler_pc,catch_type):lst, r) + +getListTuplaInner 0 str = ([],str) +getListTuplaInner n str + = let (wincl , rs1, n1) = runGetState (get :: Get Word16) str (toInt64 0) + (woutcl, rs2, n2) = runGetState (get :: Get Word16) rs1 (toInt64 0) + (winnm , rs3, n3) = runGetState (get :: Get Word16) rs2 (toInt64 0) + (inflg, rs4, n4) = runGetState (get :: Get AccessFlags) rs3 (toInt64 0) + incl = fromWord162Int wincl + outcl = fromWord162Int woutcl + innm = fromWord162Int winnm + in let (lst, r) = getListTuplaInner (n-1) rs4 in ((incl,outcl,innm,inflg):lst, r) + +getListEx 0 str = ([],str) +getListEx n str + = let (wcod, str', no) = runGetState (get :: Get Word16) str (toInt64 0) + ex = fromWord162Int wcod + in let (lst,r) = getListEx (n-1) str' in (ex:lst, r) + +getListCode 0 str = ([],str) +getListCode n str + = let (wcod, str', no) = runGetState (get :: Get Word8) str (toInt64 0) + cod = fromWord82Int wcod + in let (lst,r) = getListCode (n-1) str' in (cod:lst, r) + +getListLineNumber 0 str = ([], str) +getListLineNumber n str + = let (wstart_pc, str1, n1) = runGetState (get :: Get Word16) str (toInt64 0) + start_pc = fromWord162Int wstart_pc + (wline_number, str2, n2) = runGetState (get :: Get Word16) str1 (toInt64 0) + line_number = fromWord162Int wline_number + in let (lst,r) = getListLineNumber (n-1) str2 in ((start_pc,line_number):lst, r) + +-- Get the name from Utf8_Info in the Contant Pool list +getNameCP_Utf8 :: Int -> CP_Infos -> String +getNameCP_Utf8 index cp_infos = cad_cp $ cp_infos !! (index-1) + +fChgAttr :: CP_Infos -> Attribute_Info -> Attribute_Info +fChgAttr cp_infos (AttributeGeneric inam tam rbs) + = case getNameCP_Utf8 inam cp_infos of + "SourceFile" + -> let (wisrc, rest, n) = runGetState (get :: Get Word16) rbs (toInt64 0) + isrc = fromWord162Int wisrc + in AttributeSourceFile inam tam isrc + "Code" + -> let (wstack , rs1, n1) = runGetState (get :: Get Word16) rbs (toInt64 0) + stack = fromWord162Int wstack + (wlocal , rs2, n2) = runGetState (get :: Get Word16) rs1 (toInt64 0) + local = fromWord162Int wlocal + (wtam_code, rs3, n3) = runGetState (get :: Get Word32) rs2 (toInt64 0) + tam_code = fromWord322Int wtam_code + (lst_code, rs4) = getListCode tam_code rs3 + (wtam_ex, rs5, n4) = runGetState (get :: Get Word16) rs4 (toInt64 0) + tam_ex = fromWord162Int wtam_ex + (lst_ex, rs6) = getListExCod tam_ex rs5 + (wtam_attr,rs7,n5) = runGetState (get :: Get Word16) rs6 (toInt64 0) + tam_attr = fromWord162Int wtam_attr + (lst_attr,rs8, n6) = getListAttr cp_infos tam_attr rs7 + -- arreglar, porque no hay soporte para excepciones, ni la segunda lista de attributos ?? + in AttributeCode inam tam stack local tam_code lst_code tam_ex lst_ex tam_attr lst_attr + "LineNumberTable" + -> let (wntable, rs0, n0) = runGetState (get :: Get Word16) rbs (toInt64 0) + ntable = fromWord162Int wntable + (lst_line, rs1) = getListLineNumber ntable rs0 + in AttributeLineNumberTable inam tam ntable lst_line + "Exceptions" + -> let (wntable, rs0, n0) = runGetState (get :: Get Word16) rbs (toInt64 0) + ntable = fromWord162Int wntable + (lst_ex, rs1) = getListEx ntable rs0 + in AttributeExceptions inam tam ntable lst_ex + + "Synthetic" + -> AttributeSynthetic inam tam + + "InnerClasses" + -> let (wntable, rs0, n0) = runGetState (get :: Get Word16) rbs (toInt64 0) + ntable = fromWord162Int wntable + (lst_classes, rs1) = getListTuplaInner ntable rs0 + in AttributeInnerClasses inam tam ntable lst_classes + + "Deprecated" + -> AttributeDeprecated inam tam + + otherwise + -> AttributeGeneric inam tam rbs + + +chgAttrG_Fields :: ClassFile -> ClassFile +chgAttrG_Fields cf = cf{array_fields = new_array_fields} + where new_array_fields = map fun $ array_fields cf + fun fld = fld{array_attr_fi = new_fi fld} + new_fi fld' = map (fChgAttr (array_cp cf)) $ array_attr_fi fld' + +chgAttrG_Methods :: ClassFile -> ClassFile +chgAttrG_Methods cf = cf{array_methods = new_array_methods} + where new_array_methods = map fun $ array_methods cf + fun mth = mth{array_attr_mi = new_mi mth} + new_mi mth' = map (fChgAttr (array_cp cf)) $ array_attr_mi mth' + +chgAttrG_ClassFile :: ClassFile -> ClassFile +chgAttrG_ClassFile cf = cf{array_attributes = new_array_attributes} + where new_array_attributes = map (fChgAttr (array_cp cf)) $ array_attributes cf + + +-- functions accessors to to codify and decodify a class file format +encodeClassFile :: FilePath -> ClassFile -> IO () +encodeClassFile = encodeFile + +decodeClassFile :: FilePath -> IO ClassFile +decodeClassFile fn = do + obj <- decodeFile fn :: IO ClassFile + let obj1 = chgAttrG_ClassFile obj + obj2 = chgAttrG_Methods obj1 + obj3 = chgAttrG_Fields obj2 + return obj3 + diff --git a/src/Jvm/Data/ClassFormat.hs b/src/Jvm/Data/ClassFormat.hs new file mode 100644 --- /dev/null +++ b/src/Jvm/Data/ClassFormat.hs @@ -0,0 +1,281 @@ +module Jvm.Data.ClassFormat where +import qualified Data.ByteString.Lazy as BS + +-- class file format +data ClassFile = ClassFile { magic :: Magic + , minver :: MinorVersion + , maxver :: MajorVersion + , count_cp :: ConstantPool_Count + , array_cp :: CP_Infos + , acfg :: AccessFlags + , this :: ThisClass + , super :: SuperClass + , count_interfaces :: Interfaces_Count + , array_interfaces :: Interfaces + , count_fields :: Fields_Count + , array_fields :: Field_Infos + , count_methods :: Methods_Count + , array_methods :: Method_Infos + , count_attributes :: Attributes_Count + , array_attributes :: Attribute_Infos + } + deriving Show + +type CP_Infos = [CP_Info] +type Interfaces = [Interface] +type Field_Infos = [Field_Info] +type Method_Infos = [Method_Info] +type Attribute_Infos = [Attribute_Info] + +data Magic = Magic + deriving Show + +data MinorVersion = MinorVersion { + numMinVer :: Int + } + deriving Show + +data MajorVersion = MajorVersion { + numMaxVer :: Int + } + deriving Show + +data CP_Info = + Class_Info + { tag_cp :: Tag + , index_cp :: Index_Constant_Pool + , desc :: String + } + | FieldRef_Info + { tag_cp :: Tag + , index_name_cp :: Index_Constant_Pool + , index_nameandtype_cp :: Index_Constant_Pool + , desc :: String + } + | MethodRef_Info + { tag_cp :: Tag + , index_name_cp :: Index_Constant_Pool + , index_nameandtype_cp :: Index_Constant_Pool + , desc :: String + } + | InterfaceMethodRef_Info + { tag_cp :: Tag + , index_name_cp :: Index_Constant_Pool + , index_nameandtype_cp :: Index_Constant_Pool + , desc :: String + } + | String_Info + { tag_cp :: Tag + , index_cp :: Index_Constant_Pool + , desc :: String + } + | Integer_Info + { tag_cp :: Tag + , numi_cp :: Int + , desc :: String + } + | Float_Info + { tag_cp :: Tag + , numf_cp :: Float + , desc :: String + } + | Long_Info + { tag_cp :: Tag + , numi_l1_cp :: Int + , numi_l2_cp :: Int + , desc :: String + } + | Double_Info + { tag_cp :: Tag + , numi_d1_cp :: Int + , numi_d2_cp :: Int + , desc :: String + } + | NameAndType_Info + { tag_cp :: Tag + , index_name_cp :: Index_Constant_Pool + , index_descr_cp :: Index_Constant_Pool + , desc :: String + } + | Utf8_Info + { tag_cp :: Tag + , tam_cp :: Int + , cad_cp :: String + , desc :: String + } + deriving Show + +data Tag = TagClass + | TagFieldRef + | TagMethodRef + | TagInterfaceMethodRef + | TagString + | TagInteger + | TagFloat + | TagLong + | TagDouble + | TagNameAndType + | TagUtf8 + deriving Show + +data AccessFlags = AccessFlags [Int] + deriving Show + +acc_Public :: Int +acc_Public = 1 + +acc_Private :: Int +acc_Private = 2 + +acc_Protected :: Int +acc_Protected = 4 + +acc_Static :: Int +acc_Static = 8 + +acc_Final :: Int +acc_Final = 16 + +acc_Super_Synchronized :: Int +acc_Super_Synchronized = 32 + +acc_Volatile_Bridge :: Int +acc_Volatile_Bridge = 64 + +acc_Transient_Varargs :: Int +acc_Transient_Varargs = 128 + +acc_Native :: Int +acc_Native = 256 + +acc_Interface :: Int +acc_Interface = 512 + +acc_Abstract :: Int +acc_Abstract = 1024 + +acc_Strict :: Int +acc_Strict = 2048 + +acc_Synthetic :: Int +acc_Synthetic = 4096 + +acc_Annotation :: Int +acc_Annotation = 8192 + +acc_Enum :: Int +acc_Enum = 16384 + +data ThisClass = ThisClass { + index_th :: Index_Constant_Pool + } + deriving Show + +data SuperClass = SuperClass { + index_sp :: Index_Constant_Pool + } + deriving Show + +data Interface = Interface { + index_if :: Index_Constant_Pool + } + deriving Show + +data Field_Info = Field_Info + { af_fi :: AccessFlags + , index_name_fi :: Index_Constant_Pool -- name_index + , index_descr_fi :: Index_Constant_Pool -- descriptor_index + , tam_fi :: Int -- count_attributte + , array_attr_fi :: Attribute_Infos + } + deriving Show + +data Method_Info = Method_Info + { af_mi :: AccessFlags + , index_name_mi :: Index_Constant_Pool -- name_index + , index_descr_mi :: Index_Constant_Pool -- descriptor_index + , tam_mi :: Int -- attributes_count + , array_attr_mi :: Attribute_Infos + } + deriving Show + +data Attribute_Info = + AttributeGeneric + { index_name_attr :: Index_Constant_Pool + , tam_len_attr :: Int + , rest_attr :: BS.ByteString + } + + | AttributeConstantValue + { index_name_attr :: Index_Constant_Pool -- attribute_name_index + , tam_attr :: Int -- attribute_length + , index_value_attr :: Index_Constant_Pool -- constantvalue_index + } + | AttributeCode + { index_name_attr :: Index_Constant_Pool -- attribute_name_index + , tam_len_attr :: Int -- attribute_length + , len_stack_attr :: Int -- max_stack + , len_local_attr :: Int -- max_local + , tam_code_attr :: Int -- code_length + , array_code_attr :: ListaInt -- code como array de bytes + , tam_ex_attr :: Int -- exceptions_length + , array_ex_attr :: Tupla4Int -- no usamos + , tam_atrr_attr :: Int -- attributes_count + , array_attr_attr :: Attribute_Infos + } + + | AttributeExceptions + { index_name_attr :: Index_Constant_Pool -- attribute_name_index + , tam_len_attr :: Int -- attribute_length + , tam_num_ex_attr :: Int -- number of exceptions + , exception_index_table :: [Int] -- exception_index_table + } + + | AttributeInnerClasses + { index_name_attr :: Index_Constant_Pool -- attribute_name_index + , tam_len_attr :: Int -- attribute_length + , tam_classes :: Int -- number_classes + , array_classes :: [(Int,Int,Int,AccessFlags)] -- classes + } + + | AttributeSynthetic + { index_name_attr :: Index_Constant_Pool -- attribute_name_index + , tam_len_attr :: Int -- attribute_length + } + + | AttributeSourceFile + { index_name_attr :: Index_Constant_Pool -- attribute_name_index + , tam_len_attr :: Int -- attribute_length + , index_src_attr :: Index_Constant_Pool -- sourcefile_index + } + + | AttributeLineNumberTable + { index_name_attr :: Index_Constant_Pool -- attribute_name_index + , tam_len_attr :: Int -- attribute_length + , tam_table_attr :: Int -- lineNumberTable_length + , array_line_attr :: Tupla2Int -- (start_pc, line_number) + } + | AttributeLocalVariableTable + { index_name_attr :: Index_Constant_Pool -- attribute_name_index + , tam_len_attr :: Int -- attribute_length + , tam__table_attr :: Int -- local_varible_table_length + , array_var_attr :: Tupla5Int -- (start_pc, length, name_index, descriptor_index, inlinedex) + } + | AttributeDeprecated + { index_name_attr :: Index_Constant_Pool -- attribute_name_index + , tam_len_attr :: Int -- attribute_length + } + deriving Show + +type Tupla5Int = [(Int, Int, Int, Int, Int)] +type Tupla2Int = [(Int, Int)] +type Tupla4Int = [(Int, Int, Int, Int)] +type ListaInt = [Int] +type ConstantPool_Count = Int +type Interfaces_Count = Int +type Fields_Count = Int +type Methods_Count = Int +type Attributes_Count = Int +type Index_Constant_Pool = Int + + diff --git a/src/Jvm/PrettyClass.hs b/src/Jvm/PrettyClass.hs new file mode 100644 --- /dev/null +++ b/src/Jvm/PrettyClass.hs @@ -0,0 +1,511 @@ +{- +PrettyClass + Print the class format + + +Modifications: + +Wed May 26 10:24:58 BOT 2010 + Added support for program counter in the attribute code, now all code is well enumerated. +-} + +module Jvm.PrettyClass where +import Jvm.Data.ClassFormat + +import UU.Pretty +import Data.Bits + +instance PP ClassFile where + pp cf = pp (magic cf) + >-< pp (minver cf) + >-< pp (maxver cf) + >-< text "Constant_Pool ->" >-< pp_brackets (foldr (\cp -> (>-<) (pp cp)) empty (array_cp cf)) + >-< text "AccessFlag ->" >#< pp (acfg cf) + >-< pp (this cf) + >-< pp (super cf) + >-< pAttr "length_interfaces" (pp (count_interfaces cf)) + >-< text "Interfaces ->" >-< pp_brackets (foldr (\cp -> (>-<) (pp cp)) empty (array_interfaces cf)) + >-< pAttr "length_fields" (pp (count_fields cf)) + >-< text "Fields ->" >-< pp_brackets (foldr (\cp -> (>-<) (pp cp)) empty (array_fields cf)) + >-< pAttr "length_methods" (pp (count_methods cf)) + >-< text "Methods ->" >-< pp_brackets (foldr (\cp -> (>-<) (pp cp)) empty (array_methods cf)) + >-< pAttr "length_attributes" (pp (count_attributes cf)) + >-< text "Attributes ->" >-< pp_brackets (foldr (\cp -> (>-<) (pp cp)) empty (array_attributes cf)) + +pAttr name pvalue = text name >#< text "=" >#< pvalue + +instance PP Magic where + pp mg = text "Magic -> " >|< text "0xcafe 0xbabe" + +instance PP MinorVersion where + pp mv = text "Minor_Version -> " >|< pp (numMinVer mv) + +instance PP MajorVersion where + pp mv = text "Major_Version -> " >|< pp (numMaxVer mv) + +instance PP CP_Info where + pp (Class_Info tag index _) + = let ptag = pAttr "Tag" (pp tag) + picp = pAttr "index_cp" (pp index) + in indent 3 (pp_block "{" "}" ", " [ptag, picp]) + + pp (FieldRef_Info tag ind1 ind2 _) + = let ptag = pAttr "Tag" (pp tag) + picp1 = pAttr "index_cp" (pp ind1) + picp2 = pAttr "index_NameAndType_cp" (pp ind2) + in indent 3 (pp_block "{" "}" ", " [ptag, picp1, picp2]) + + pp (MethodRef_Info tag ind1 ind2 _) + = let ptag = pAttr "Tag" (pp tag) + picp1 = pAttr "index_cp" (pp ind1) + picp2 = pAttr "index_NameAndType_cp" (pp ind2) + in indent 3 (pp_block "{" "}" ", " [ptag, picp1, picp2]) + + pp (InterfaceMethodRef_Info tag ind1 ind2 _) + = let ptag = pAttr "Tag" (pp tag) + picp1 = pAttr "index_cp" (pp ind1) + picp2 = pAttr "index_NameAndType_cp" (pp ind2) + in indent 3 (pp_block "{" "}" ", " [ptag, picp1, picp2]) + + pp (String_Info tag index _) + = let ptag = pAttr "Tag" (pp tag) + picp = pAttr "index_cp" (pp index) + in indent 3 (pp_block "{" "}" ", " [ptag, picp]) + + pp (Float_Info tag float _) + = let ptag = pAttr "Tag" (pp tag) + pfloat = pAttr "Value" (pp float) + in indent 3 (pp_block "{" "}" ", " [ptag, pfloat]) + + pp (Long_Info tag int1 int2 _) + = let ptag = pAttr "Tag" (pp tag) + pint1 = pAttr "Value_1" (pp int1) + pint2 = pAttr "Value_2" (pp int2) + in indent 3 (pp_block "{" "}" ", " [ptag, pint1, pint2]) + + pp (Double_Info tag int1 int2 _) + = let ptag = pAttr "Tag" (pp tag) + pint1 = pAttr "Value_1" (pp int1) + pint2 = pAttr "Value_2" (pp int2) + in indent 3 (pp_block "{" "}" ", " [ptag, pint1, pint2]) + + pp (NameAndType_Info tag ind1 ind2 _) + = let ptag = pAttr "Tag" (pp tag) + picp1 = pAttr "index_cp" (pp ind1) + picp2 = pAttr "index_desc_cp" (pp ind2) + in indent 3 (pp_block "{" "}" ", " [ptag, picp1, picp2]) + + pp (Utf8_Info tag tam str _) + = let ptag = pAttr "Tag" (pp tag) + plen = pAttr "length" (pp tam) + pstr = pAttr "Value" (text str) + in indent 3 (pp_block "{" "}" ", " [ptag, plen, pstr]) + +instance PP Tag where + pp (TagClass) = text "Class" + pp (TagFieldRef) = text "FieldRef" + pp (TagMethodRef) = text "MethodRef" + pp (TagInterfaceMethodRef) = text "InterfaceMethodRef" + pp (TagString) = text "String" + pp (TagInteger) = text "Integer" + pp (TagFloat) = text "Float" + pp (TagLong) = text "Long" + pp (TagDouble) = text "Double" + pp (TagNameAndType) = text "NameAndType" + pp (TagUtf8) = text "Utf8" + +instance PP AccessFlags where + pp (AccessFlags lst) = hlist $ map showFlag lst + where showFlag fg + | fg == acc_Public = text "Public" + | fg == acc_Private = text "Private" + | fg == acc_Protected = text "Protected" + | fg == acc_Static = text "Static" + | fg == acc_Final = text "Final" + | fg == acc_Super_Synchronized = text "Super" + | fg == acc_Volatile_Bridge = text "Volatile" + | fg == acc_Transient_Varargs = text "Transient" + | fg == acc_Native = text "Native" + | fg == acc_Interface = text "Interface" + | fg == acc_Abstract = text "Abstract" + | fg == acc_Strict = text "Strict" + | fg == acc_Synthetic = text "Synthetic" + | fg == acc_Enum = text "Enum" + | otherwise = text "No Spec" + +instance PP ThisClass where + pp tc = text "ThisClass_index_cp -> " >|< pp (index_th tc) + +instance PP SuperClass where + pp tc = text "SuperClass_index_cp -> " >|< pp (index_sp tc) + +instance PP Interface where + pp iif = text "Interface_index_cp -> " >|< pp (index_if iif) + +instance PP Field_Info where + pp fdi = let fg = pp (af_fi fdi) + ind1 = pAttr "index_name_cp" (pp (index_name_fi fdi)) + ind2 = pAttr "index_desc_cp" (pp (index_descr_fi fdi)) + tam = pAttr "length" (pp (tam_fi fdi)) + lst = text "Constant_Pool ->" >-< pp_brackets (foldr (\at -> (>-<) (pp at)) empty (array_attr_fi fdi)) + in text "Field_Info" >-< pp_block "{" "}" ", " [fg, ind1, ind2, tam, lst] + +instance PP Method_Info where + pp mth = let fg = pp_mth (af_mi mth) + ind1 = pAttr "index_name_cp" (pp (index_name_mi mth)) + ind2 = pAttr "index_desc_cp" (pp (index_descr_mi mth)) + tam = pAttr "length_Attr" (pp (tam_mi mth)) + lst = text "Attributes ->" >-< pp_brackets (foldr (\at -> (>-<) (pp at)) empty (array_attr_mi mth)) + in text "Method_Info" >-< pp_block "{" "}" ", " [fg, ind1, ind2, tam, lst] + where pp_mth (AccessFlags lst) = hlist $ map showFlag lst + showFlag fg + | fg == acc_Public = text "Public" + | fg == acc_Private = text "Private" + | fg == acc_Protected = text "Protected" + | fg == acc_Static = text "Static" + | fg == acc_Final = text "Final" + | fg == acc_Super_Synchronized = text "Synchronized" + | fg == acc_Volatile_Bridge = text "Bridge" + | fg == acc_Transient_Varargs = text "Varargs" + | fg == acc_Native = text "Native" + | fg == acc_Interface = text "Interface" + | fg == acc_Abstract = text "Abstract" + | fg == acc_Strict = text "Strict" + | fg == acc_Synthetic = text "Synthetic" + | fg == acc_Enum = text "Enum" + | otherwise = text "No Spec" + +instance PP Attribute_Info where + pp (AttributeGeneric inam tam rest) + = let pinam = pAttr "index_name" (pp inam) + plen = pAttr "length" (pp tam) + prest = pAttr "Rest" (text (show rest)) + in indent 3 (text "AttributeGeneric" >-< pp_block "{" "}" ", " [pinam, plen, prest]) + + pp (AttributeConstantValue inam tam ivalue) + = let pinam = pAttr "index_name" (pp inam) + plen = pAttr "length" (pp tam) + pivalue = pAttr "index_value" (pp ivalue) + in indent 3 (text "AttributeConstantValue" >-< pp_block "{" "}" ", " [pinam, plen, pivalue]) + + pp (AttributeCode inam tama lens lenl tamc lstc tame lste tamat lstat) + = let pinam = pAttr "index_name" (pp inam) + plen1 = pAttr "length" (pp tama) + plen2 = pAttr "length_stack" (pp lens) + plen3 = pAttr "length_local" (pp lenl) + plen4 = pAttr "length_code" (pp tamc) + --listc = indent 2 (vlist (map (text ">" >#<) (instruction2pp lstc))) --c) lstc)) + listc = indent 2 $ vlist $ instruction2pp lstc 0 + plen5 = pAttr "length_exeptions" (pp tame) + liste = pp_brackets (foldr (>-<) empty (map (\(a,b,c,d) -> indent 2 (pp_block "{" "}" ", " [pAttr "start_counter" (pp a),pAttr "end_counter" (pp b),pAttr "handler_counter" (pp c),pAttr "catch_type" (pp d)])) lste)) + plen6 = pAttr "length_attributes" (pp tamat) + listat = text "Attributes ->" >-< pp_brackets (foldr (\at -> (>-<) (pp at)) empty lstat) + in indent 3 (text "AttributeCode" >-< pp_block "{" "}" ", " [pinam, plen1, plen2, plen3, plen4, listc, plen5, liste, plen6, listat]) + + pp (AttributeSourceFile inam tam idesc) + = let pinam = pAttr "index_name" (pp inam) + ptam = pAttr "length" (pp tam) + pidesc = pAttr "index_desc" (pp idesc) + in indent 3 (text "AttributeSourceFile" >-< pp_block "{" "}" ", " [pinam, ptam, pidesc]) + + pp (AttributeLineNumberTable inam tam tamln lstln) + = let pinam = pAttr "index_name" (pp inam) + ptam = pAttr "length" (pp tam) + ptamln = pAttr "length_linenumber" (pp tamln) + listln = foldr (>-<) empty (map (\(a,b) -> indent 2 (pp_block "{" "}" ", " [pAttr "start_counter" (pp a),pAttr "line_number" (pp b)])) lstln) + in indent 3 (text "AttributeLineNumberTable" >-< pp_block "{" "}" ", " [pinam, ptam, ptamln, listln]) + + pp (AttributeLocalVariableTable inam tam tamlv lstlv) + = let pinam = pAttr "index_name" (pp inam) + ptam = pAttr "length" (pp tam) + ptamlv = pAttr "length_linenumber" (pp tamlv) + listln = foldr (>-<) empty (map (\(a,b,c,d,e) -> indent 2 (pp_block "{" "}" ", " [pAttr "start_counter" (pp a),pAttr "length" (pp b),pAttr "name_index" (pp c),pAttr "desc_index" (pp d), pAttr "index" (pp e)])) lstlv) + in indent 3 (text "AttributeLocalVariableTable" >-< pp_block "{" "}" ", " [pinam, ptam, ptamlv, listln]) + +instruction2pp :: [Int] -> Int -> [PP_Doc] +instruction2pp [] counter = [] +instruction2pp (inst:xs) counter = + case inst of + 0 -> (pp counter >#< text "nop"):instruction2pp xs (counter + 1) + 1 -> (pp counter >#< text "aconst_null"):instruction2pp xs (counter + 1) + 2 -> (pp counter >#< text "iconst_m1"):instruction2pp xs (counter + 1) + 3 -> (pp counter >#< text "iconst_0"):instruction2pp xs (counter + 1) + 4 -> (pp counter >#< text "iconst_1"):instruction2pp xs (counter + 1) + 5 -> (pp counter >#< text "iconst_2"):instruction2pp xs (counter + 1) + 6 -> (pp counter >#< text "iconst_3"):instruction2pp xs (counter + 1) + 7 -> (pp counter >#< text "iconst_4"):instruction2pp xs (counter + 1) + 8 -> (pp counter >#< text "iconst_5"):instruction2pp xs (counter + 1) + 9 -> (pp counter >#< text "lconst_0"):instruction2pp xs (counter + 1) + 10 -> (pp counter >#< text "lconst_1"):instruction2pp xs (counter + 1) + 11 -> (pp counter >#< text "fconst_0"):instruction2pp xs (counter + 1) + 12 -> (pp counter >#< text "fconst_1"):instruction2pp xs (counter + 1) + 13 -> (pp counter >#< text "fconst_2"):instruction2pp xs (counter + 1) + 14 -> (pp counter >#< text "dconst_0"):instruction2pp xs (counter + 1) + 15 -> (pp counter >#< text "dconst_1"):instruction2pp xs (counter + 1) + 16 -> (pp counter >#< text "bipush" >#< pp (take 1 xs)):instruction2pp (drop 1 xs) (counter + 2) + 17 -> (pp counter >#< text "sipush" >#< let [b1,b2] = take 2 xs in pp b1 >#< pp b2):instruction2pp (drop 2 xs) (counter + 3) + 18 -> (pp counter >#< text "ldc" >#< pp (take 1 xs)):instruction2pp (drop 1 xs) (counter + 2) + 19 -> (pp counter >#< text "ldc_w" >#< let [b1,b2] = take 2 xs in pp b1 >#< pp b2):instruction2pp (drop 2 xs) (counter + 3) + 20 -> (pp counter >#< text "ldc2_w" >#< let [b1,b2] = take 2 xs in pp b1 >#< pp b2):instruction2pp (drop 2 xs) (counter + 3) + 21 -> (pp counter >#< text "iload" >#< pp (take 1 xs)):instruction2pp (drop 1 xs) (counter + 2) + 22 -> (pp counter >#< text "lload" >#< pp (take 1 xs)):instruction2pp (drop 1 xs) (counter + 2) + 23 -> (pp counter >#< text "fload" >#< pp (take 1 xs)):instruction2pp (drop 1 xs) (counter + 2) + 24 -> (pp counter >#< text "dload" >#< pp (take 1 xs)):instruction2pp (drop 1 xs) (counter + 2) + 25 -> (pp counter >#< text "aload" >#< pp (take 1 xs)):instruction2pp (drop 1 xs) (counter + 2) + 26 -> (pp counter >#< text "iload_0"):instruction2pp xs (counter + 1) + 27 -> (pp counter >#< text "iload_1"):instruction2pp xs (counter + 1) + 28 -> (pp counter >#< text "iload_2"):instruction2pp xs (counter + 1) + 29 -> (pp counter >#< text "iload_3"):instruction2pp xs (counter + 1) + 30 -> (pp counter >#< text "lload_0"):instruction2pp xs (counter + 1) + 31 -> (pp counter >#< text "lload_1"):instruction2pp xs (counter + 1) + 32 -> (pp counter >#< text "lload_2"):instruction2pp xs (counter + 1) + 33 -> (pp counter >#< text "lload_3"):instruction2pp xs (counter + 1) + 34 -> (pp counter >#< text "fload_0"):instruction2pp xs (counter + 1) + 35 -> (pp counter >#< text "fload_1"):instruction2pp xs (counter + 1) + 36 -> (pp counter >#< text "fload_2"):instruction2pp xs (counter + 1) + 37 -> (pp counter >#< text "fload_3"):instruction2pp xs (counter + 1) + 38 -> (pp counter >#< text "dload_0"):instruction2pp xs (counter + 1) + 39 -> (pp counter >#< text "dload_1"):instruction2pp xs (counter + 1) + 40 -> (pp counter >#< text "dload_2"):instruction2pp xs (counter + 1) + 41 -> (pp counter >#< text "dload_3"):instruction2pp xs (counter + 1) + 42 -> (pp counter >#< text "aload_0"):instruction2pp xs (counter + 1) + 43 -> (pp counter >#< text "aload_1"):instruction2pp xs (counter + 1) + 44 -> (pp counter >#< text "aload_2"):instruction2pp xs (counter + 1) + 45 -> (pp counter >#< text "aload_3"):instruction2pp xs (counter + 1) + 46 -> (pp counter >#< text "iaload"):instruction2pp xs (counter + 1) + 47 -> (pp counter >#< text "laload"):instruction2pp xs (counter + 1) + 48 -> (pp counter >#< text "faload"):instruction2pp xs (counter + 1) + 49 -> (pp counter >#< text "daload"):instruction2pp xs (counter + 1) + 50 -> (pp counter >#< text "aaload"):instruction2pp xs (counter + 1) + 51 -> (pp counter >#< text "baload"):instruction2pp xs (counter + 1) + 52 -> (pp counter >#< text "caload"):instruction2pp xs (counter + 1) + 53 -> (pp counter >#< text "saload"):instruction2pp xs (counter + 1) + 54 -> (pp counter >#< text "istore" >#< pp (take 1 xs)):instruction2pp (drop 1 xs) (counter + 2) + 55 -> (pp counter >#< text "lstore" >#< pp (take 1 xs)):instruction2pp (drop 1 xs) (counter + 2) + 56 -> (pp counter >#< text "fstore" >#< pp (take 1 xs)):instruction2pp (drop 1 xs) (counter + 2) + 57 -> (pp counter >#< text "dstore" >#< pp (take 1 xs)):instruction2pp (drop 1 xs) (counter + 2) + 58 -> (pp counter >#< text "astore" >#< pp (take 1 xs)):instruction2pp (drop 1 xs) (counter + 2) + 59 -> (pp counter >#< text "istore_0"):instruction2pp xs (counter + 1) + 60 -> (pp counter >#< text "istore_1"):instruction2pp xs (counter + 1) + 61 -> (pp counter >#< text "istore_2"):instruction2pp xs (counter + 1) + 62 -> (pp counter >#< text "istore_3"):instruction2pp xs (counter + 1) + 63 -> (pp counter >#< text "lstore_0"):instruction2pp xs (counter + 1) + 64 -> (pp counter >#< text "lstore_1"):instruction2pp xs (counter + 1) + 65 -> (pp counter >#< text "lstore_2"):instruction2pp xs (counter + 1) + 66 -> (pp counter >#< text "lstore_3"):instruction2pp xs (counter + 1) + 67 -> (pp counter >#< text "fstore_0"):instruction2pp xs (counter + 1) + 68 -> (pp counter >#< text "fstore_1"):instruction2pp xs (counter + 1) + 69 -> (pp counter >#< text "fstore_2"):instruction2pp xs (counter + 1) + 70 -> (pp counter >#< text "fstore_3"):instruction2pp xs (counter + 1) + 71 -> (pp counter >#< text "dstore_0"):instruction2pp xs (counter + 1) + 72 -> (pp counter >#< text "dstore_1"):instruction2pp xs (counter + 1) + 73 -> (pp counter >#< text "dstore_2"):instruction2pp xs (counter + 1) + 74 -> (pp counter >#< text "dstore_3"):instruction2pp xs (counter + 1) + 75 -> (pp counter >#< text "astore_0"):instruction2pp xs (counter + 1) + 76 -> (pp counter >#< text "astore_1"):instruction2pp xs (counter + 1) + 77 -> (pp counter >#< text "astore_2"):instruction2pp xs (counter + 1) + 78 -> (pp counter >#< text "astore_3"):instruction2pp xs (counter + 1) + 79 -> (pp counter >#< text "iastore"):instruction2pp xs (counter + 1) + 80 -> (pp counter >#< text "lastore"):instruction2pp xs (counter + 1) + 81 -> (pp counter >#< text "fastore"):instruction2pp xs (counter + 1) + 82 -> (pp counter >#< text "dastore"):instruction2pp xs (counter + 1) + 83 -> (pp counter >#< text "aastore"):instruction2pp xs (counter + 1) + 84 -> (pp counter >#< text "bastore"):instruction2pp xs (counter + 1) + 85 -> (pp counter >#< text "castore"):instruction2pp xs (counter + 1) + 86 -> (pp counter >#< text "sastore"):instruction2pp xs (counter + 1) + 87 -> (pp counter >#< text "pop"):instruction2pp xs (counter + 1) + 88 -> (pp counter >#< text "pop2"):instruction2pp xs (counter + 1) + 89 -> (pp counter >#< text "dup"):instruction2pp xs (counter + 1) + 90 -> (pp counter >#< text "dup_x1"):instruction2pp xs (counter + 1) + 91 -> (pp counter >#< text "dup_x2"):instruction2pp xs (counter + 1) + 92 -> (pp counter >#< text "dup2"):instruction2pp xs (counter + 1) + 93 -> (pp counter >#< text "dup2_x1"):instruction2pp xs (counter + 1) + 94 -> (pp counter >#< text "dup2_x2"):instruction2pp xs (counter + 1) + 95 -> (pp counter >#< text "swap"):instruction2pp xs (counter + 1) + 96 -> (pp counter >#< text "iadd"):instruction2pp xs (counter + 1) + 97 -> (pp counter >#< text "ladd"):instruction2pp xs (counter + 1) + 98 -> (pp counter >#< text "fadd"):instruction2pp xs (counter + 1) + 99 -> (pp counter >#< text "dadd"):instruction2pp xs (counter + 1) + 100 -> (pp counter >#< text "isub"):instruction2pp xs (counter + 1) + 101 -> (pp counter >#< text "lsub"):instruction2pp xs (counter + 1) + 102 -> (pp counter >#< text "fsub"):instruction2pp xs (counter + 1) + 103 -> (pp counter >#< text "dsub"):instruction2pp xs (counter + 1) + 104 -> (pp counter >#< text "imul"):instruction2pp xs (counter + 1) + 105 -> (pp counter >#< text "lmul"):instruction2pp xs (counter + 1) + 106 -> (pp counter >#< text "fmul"):instruction2pp xs (counter + 1) + 107 -> (pp counter >#< text "dmul"):instruction2pp xs (counter + 1) + 108 -> (pp counter >#< text "idiv"):instruction2pp xs (counter + 1) + 109 -> (pp counter >#< text "ldiv"):instruction2pp xs (counter + 1) + 110 -> (pp counter >#< text "fdiv"):instruction2pp xs (counter + 1) + 111 -> (pp counter >#< text "ddiv"):instruction2pp xs (counter + 1) + 112 -> (pp counter >#< text "irem"):instruction2pp xs (counter + 1) + 113 -> (pp counter >#< text "lrem"):instruction2pp xs (counter + 1) + 114 -> (pp counter >#< text "frem"):instruction2pp xs (counter + 1) + 115 -> (pp counter >#< text "drem"):instruction2pp xs (counter + 1) + 116 -> (pp counter >#< text "ineg"):instruction2pp xs (counter + 1) + 117 -> (pp counter >#< text "lneg"):instruction2pp xs (counter + 1) + 118 -> (pp counter >#< text "fneg"):instruction2pp xs (counter + 1) + 119 -> (pp counter >#< text "dneg"):instruction2pp xs (counter + 1) + 120 -> (pp counter >#< text "ishl"):instruction2pp xs (counter + 1) + 121 -> (pp counter >#< text "lshl"):instruction2pp xs (counter + 1) + 122 -> (pp counter >#< text "ishr"):instruction2pp xs (counter + 1) + 123 -> (pp counter >#< text "lshr"):instruction2pp xs (counter + 1) + 124 -> (pp counter >#< text "iushr"):instruction2pp xs (counter + 1) + 125 -> (pp counter >#< text "lushr"):instruction2pp xs (counter + 1) + 126 -> (pp counter >#< text "iand"):instruction2pp xs (counter + 1) + 127 -> (pp counter >#< text "land"):instruction2pp xs (counter + 1) + 128 -> (pp counter >#< text "ior"):instruction2pp xs (counter + 1) + 129 -> (pp counter >#< text "lor"):instruction2pp xs (counter + 1) + 130 -> (pp counter >#< text "ixor"):instruction2pp xs (counter + 1) + 131 -> (pp counter >#< text "lxor"):instruction2pp xs (counter + 1) + 132 -> (pp counter >#< text "iinc" >#< let [b1,b2] = take 2 xs in pp b1 >#< pp b2):instruction2pp (drop 2 xs) (counter + 3) + 133 -> (pp counter >#< text "i2l"):instruction2pp xs (counter + 1) + 134 -> (pp counter >#< text "i2f"):instruction2pp xs (counter + 1) + 135 -> (pp counter >#< text "i2d"):instruction2pp xs (counter + 1) + 136 -> (pp counter >#< text "l2i"):instruction2pp xs (counter + 1) + 137 -> (pp counter >#< text "l2f"):instruction2pp xs (counter + 1) + 138 -> (pp counter >#< text "l2d"):instruction2pp xs (counter + 1) + 139 -> (pp counter >#< text "f2i"):instruction2pp xs (counter + 1) + 140 -> (pp counter >#< text "f2l"):instruction2pp xs (counter + 1) + 141 -> (pp counter >#< text "f2d"):instruction2pp xs (counter + 1) + 142 -> (pp counter >#< text "d2i"):instruction2pp xs (counter + 1) + 143 -> (pp counter >#< text "d2l"):instruction2pp xs (counter + 1) + 144 -> (pp counter >#< text "d2f"):instruction2pp xs (counter + 1) + 145 -> (pp counter >#< text "i2b"):instruction2pp xs (counter + 1) + 146 -> (pp counter >#< text "i2c"):instruction2pp xs (counter + 1) + 147 -> (pp counter >#< text "i2s"):instruction2pp xs (counter + 1) + 148 -> (pp counter >#< text "lcmp"):instruction2pp xs (counter + 1) + 149 -> (pp counter >#< text "fcmpl"):instruction2pp xs (counter + 1) + 150 -> (pp counter >#< text "fcmpg"):instruction2pp xs (counter + 1) + 151 -> (pp counter >#< text "dcmpl"):instruction2pp xs (counter + 1) + 152 -> (pp counter >#< text "dcmpg"):instruction2pp xs (counter + 1) + 153 -> (pp counter >#< text "ifeq" >#< let n = fromBytes2Int (take 2 xs) in pp (getSignedInt (n+counter) 17)):instruction2pp (drop 2 xs) (counter + 3) + 154 -> (pp counter >#< text "ifne" >#< let n = fromBytes2Int (take 2 xs) in pp (getSignedInt (n+counter) 17)):instruction2pp (drop 2 xs) (counter + 3) + 155 -> (pp counter >#< text "iflt" >#< let n = fromBytes2Int (take 2 xs) in pp (getSignedInt (n+counter) 17)):instruction2pp (drop 2 xs) (counter + 3) + 156 -> (pp counter >#< text "ifge" >#< let n = fromBytes2Int (take 2 xs) in pp (getSignedInt (n+counter) 17)):instruction2pp (drop 2 xs) (counter + 3) + 157 -> (pp counter >#< text "ifgt" >#< let n = fromBytes2Int (take 2 xs) in pp (getSignedInt (n+counter) 17)):instruction2pp (drop 2 xs) (counter + 3) + 158 -> (pp counter >#< text "ifle" >#< let n = fromBytes2Int (take 2 xs) in pp (getSignedInt (n+counter) 17)):instruction2pp (drop 2 xs) (counter + 3) + 159 -> (pp counter >#< text "if_icmpeq" >#< let n = fromBytes2Int (take 2 xs) in pp (getSignedInt (n+counter) 17)):instruction2pp (drop 2 xs) (counter + 3) + 160 -> (pp counter >#< text "if_icmpne" >#< let n = fromBytes2Int (take 2 xs) in pp (getSignedInt (n+counter) 17)):instruction2pp (drop 2 xs) (counter + 3) + 161 -> (pp counter >#< text "if_icmplt" >#< let n = fromBytes2Int (take 2 xs) in pp (getSignedInt (n+counter) 17)):instruction2pp (drop 2 xs) (counter + 3) + 162 -> (pp counter >#< text "if_icmpge" >#< let n = fromBytes2Int (take 2 xs) in pp (getSignedInt (n+counter) 17)):instruction2pp (drop 2 xs) (counter + 3) + 163 -> (pp counter >#< text "if_icmpgt" >#< let n = fromBytes2Int (take 2 xs) in pp (getSignedInt (n+counter) 17)):instruction2pp (drop 2 xs) (counter + 3) + 164 -> (pp counter >#< text "if_icmple" >#< let n = fromBytes2Int (take 2 xs) in pp (getSignedInt (n+counter) 17)):instruction2pp (drop 2 xs) (counter + 3) + 165 -> (pp counter >#< text "if_acmpeq" >#< let n = fromBytes2Int (take 2 xs) in pp (getSignedInt (n+counter) 17)):instruction2pp (drop 2 xs) (counter + 3) + 166 -> (pp counter >#< text "if_acmpne" >#< let n = fromBytes2Int (take 2 xs) in pp (getSignedInt (n+counter) 17)):instruction2pp (drop 2 xs) (counter + 3) + 167 -> (pp counter >#< text "goto" >#< let n = fromBytes2Int (take 2 xs) in pp (getSignedInt (n+counter) 17)):instruction2pp (drop 2 xs) (counter + 3) + 168 -> (pp counter >#< text "jsr" >#< let n = fromBytes2Int (take 2 xs) in pp (getSignedInt (n+counter) 17)):instruction2pp (drop 2 xs) (counter + 3) + 169 -> (pp counter >#< text "ret" >#< pp (take 1 xs)):instruction2pp (drop 1 xs) (counter + 2) + 170 -> let npad = (counter + 1) `mod` 4 + (bpad, rs1) = splitAt npad xs + (defpos,rs2) = (fromBytes2Int $ take 4 rs1, drop 4 rs1) + (low, rs3) = (fromBytes2Int $ take 4 rs1, drop 4 rs2) + (hight, rs4) = (fromBytes2Int $ take 4 rs1, drop 4 rs3) + (lstbr, rs5) = let n = 4*(hight-low+1) in (toInts (take n rs4), drop n rs4) + in (pp counter >#< text "tableswitch" >#< text "[ hight :" >#< pp hight >#< text "low :" >#< pp low >#< text " ]" >-< + vlist ((map (\br -> text "->" >#< pp br) lstbr) ++ [text "-> default :" >#< pp defpos])) : instruction2pp rs5 (counter + npad + 12 + (hight-low+1)*4) + 171 -> let npad = (counter+1) `mod` 4 + (bpad, rs1) = splitAt npad xs + (defpos,rs2) = (fromBytes2Int $ take 4 rs1, drop 4 rs1) + (npairs,rs3) = (fromBytes2Int $ take 4 rs2, drop 4 rs2) + (lstpairs, rs4) = (fromBytes2Tupla $ take (npairs*2*4) rs3, drop (npairs*2*4) rs3) + in (pp counter >#< text "lookupswitch" >#< text "[ pad :" >#< pp npad >#< text ", ntable :" >#< pp npairs >#< text " ]" >-< + vlist ((map (\(n1,n2) -> pp n1 >#< text "->" >#< pp n2) lstpairs) ++ [text "default ->" >#< pp defpos])) : instruction2pp rs4 (counter + npad + 8 + npairs*2*4) + 172 -> (pp counter >#< text "ireturn"):instruction2pp xs (counter + 1) + 173 -> (pp counter >#< text "lreturn"):instruction2pp xs (counter + 1) + 174 -> (pp counter >#< text "freturn"):instruction2pp xs (counter + 1) + 175 -> (pp counter >#< text "dreturn"):instruction2pp xs (counter + 1) + 176 -> (pp counter >#< text "areturn"):instruction2pp xs (counter + 1) + 177 -> (pp counter >#< text "return"):instruction2pp xs (counter + 1) + 178 -> (pp counter >#< text "getstatic" >#< let [b1,b2] = take 2 xs in pp b1 >#< pp b2):instruction2pp (drop 2 xs) (counter + 3) + 179 -> (pp counter >#< text "putstatic" >#< let [b1,b2] = take 2 xs in pp b1 >#< pp b2):instruction2pp (drop 2 xs) (counter + 3) + 180 -> (pp counter >#< text "getfield" >#< let [b1,b2] = take 2 xs in pp b1 >#< pp b2):instruction2pp (drop 2 xs) (counter + 3) + 181 -> (pp counter >#< text "putfield" >#< let [b1,b2] = take 2 xs in pp b1 >#< pp b2):instruction2pp (drop 2 xs) (counter + 3) + 182 -> (pp counter >#< text "invokevirtual" >#< let [b1,b2] = take 2 xs in pp b1 >#< pp b2):instruction2pp (drop 2 xs) (counter + 3) + 183 -> (pp counter >#< text "invokespecial" >#< let [b1,b2] = take 2 xs in pp b1 >#< pp b2):instruction2pp (drop 2 xs) (counter + 3) + 184 -> (pp counter >#< text "invokestatic" >#< let [b1,b2] = take 2 xs in pp b1 >#< pp b2):instruction2pp (drop 2 xs) (counter + 3) + 185 -> (pp counter >#< text "invokeinterface" >#< let [b1,b2,b3,b4] = take 4 xs in pp b1 >#< pp b2 >#< pp b3 >#< pp b4):instruction2pp (drop 4 xs) (counter + 5) + --186 (0xba) xxxunusedxxx1 + 187 -> (pp counter >#< text "new" >#< let [b1,b2] = take 2 xs in pp b1 >#< pp b2):instruction2pp (drop 2 xs) (counter + 3) + 188 -> (pp counter >#< text "newarray" >#< pp (take 1 xs)):instruction2pp (drop 1 xs) (counter + 2) + 189 -> (pp counter >#< text "anewarray" >#< let [b1,b2] = take 2 xs in pp b1 >#< pp b2):instruction2pp (drop 2 xs) (counter + 3) + 190 -> (pp counter >#< text "arraylength"):instruction2pp xs (counter + 1) + 191 -> (pp counter >#< text "athrow"):instruction2pp xs (counter + 1) + 192 -> (pp counter >#< text "checkcast" >#< let [b1,b2] = take 2 xs in pp b1 >#< pp b2):instruction2pp (drop 2 xs) (counter + 3) + 193 -> (pp counter >#< text "instanceof" >#< let [b1,b2] = take 2 xs in pp b1 >#< pp b2):instruction2pp (drop 2 xs) (counter + 3) + 194 -> (pp counter >#< text "monitorenter"):instruction2pp xs (counter + 1) + 195 -> (pp counter >#< text "monitorexit"):instruction2pp xs (counter + 1) + 196 -> let (vinstr, rs1) = (head xs, tail xs) + (vindex, rs2) = (fromBytes2Int (take 2 rs1), drop 2 rs1) + in if (vinstr == 132) -- 132 == iinc + then let (vconst, rs3) = (fromBytes2Int (take 2 rs2), drop 2 rs2) + in (pp counter >#< text "wide" >#< toPP vinstr >#< text "index :" >#< pp vindex >#< text "const :" >#< pp vconst) : instruction2pp rs3 (counter + 6) + else (pp counter >#< text "wide" >#< toPP vinstr >#< text "index :" >#< pp vindex) : instruction2pp rs2 (counter + 4) + 197 -> (pp counter >#< text "multianewarray" >#< let [b1,b2,b3] = take 3 xs in pp b1 >#< pp b2 >#< pp b3):instruction2pp (drop 3 xs) (counter + 4) + 198 -> (pp counter >#< text "ifnull" >#< let n = fromBytes2Int (take 2 xs) in pp (getSignedInt (n+counter) 17)):instruction2pp (drop 2 xs) (counter + 3) + 199 -> (pp counter >#< text "ifnonnull" >#< let n = fromBytes2Int (take 2 xs) in pp (getSignedInt (n+counter) 17)):instruction2pp (drop 2 xs) (counter + 3) + 200 -> (pp counter >#< text "goto_w" >#< let n = fromBytes2Int (take 4 xs) in pp (getSignedInt (n+counter) 33)):instruction2pp (drop 4 xs) (counter + 5) + 201 -> (pp counter >#< text "jsr_w" >#< let n = fromBytes2Int (take 4 xs) in pp (getSignedInt (n+counter) 33)):instruction2pp (drop 4 xs) (counter + 5) + --Reserved ocounterodes: + --202 (0xca) breakpoint + --254 (0xfe) impdep1 + --255 (0xff) impdep2 + +-- Auxiliar functions +toPP :: Int -> PP_Doc +toPP i = case i of + 21 -> text "iload" + 22 -> text "lload" + 23 -> text "fload" + 24 -> text "dload" + 25 -> text "aload" + 54 -> text "istore" + 55 -> text "lstore" + 56 -> text "fstore" + 57 -> text "dstore" + 58 -> text "astore" + 169 -> text "ret" + 139 -> text "iinc" + +fromBytes2Tupla :: [Int] -> [(Int, Int)] +fromBytes2Tupla = entuplar . toInts + +entuplar [] = [] +entuplar (x:y:zs) = (x,y) : entuplar zs + +{- +fromBytes2Tupla xs = (\(_, lst1, lst2) -> zip lst1 lst2) $ foldr cons nil (toInts xs) + where nil = (0, [], []) + cons b (v, lst1, lst2) = if odd v then (v+1, lst1, b:lst2) else (v+1, b:lst1, lst2) +-} + +toInts :: [Int] -> [Int] +toInts [] = [] +toInts xs = let v = fromBytes2Int $ take 4 xs + in v : (toInts $ drop 4 xs) + +fromBytes2Int :: [Int] -> Int +fromBytes2Int xs = fst $ foldr cons nil xs + where nil = (0, -8) + cons n (v,c) = (n =<<= (c+8) =|= v, c+8) + +infixl 5 =<<=, =|= + +(=<<=) :: Int -> Int -> Int +a =<<= b = a `shiftL` b + +(=|=) :: Int -> Int -> Int +a =|= b = a .|. b + +getSignedInt :: Int -> Int -> Int +getSignedInt n t = let (l:ls) = reverse $ toBinary n + (xs, ys) = if length (l:ls) == t then span (== 0) (if l == 1 then ls else l:ls) else ([], l:ls) + in toInt ys (length ys - 1) + where toBinary :: Int -> [Int] + toBinary 0 = [] + toBinary n = (n `mod` 2) : (toBinary (n `div` 2)) + + toInt :: [Int] -> Int -> Int + toInt [] c = 0 + toInt (n:ns) c = n * (2 ^ c) + toInt ns (c-1) + diff --git a/src/Main.hs b/src/Main.hs new file mode 100644 --- /dev/null +++ b/src/Main.hs @@ -0,0 +1,18 @@ +module Main where + +import Jvm.Data.ClassFormat +import Jvm.BinaryClass +import Jvm.PrettyClass +import UU.Pretty +import System +import System.Cmd + +main::IO() +main = do + args <- getArgs + let file = (!!) args 0 + putStrLn "Decompiler Bytecode Java\n" + obj <- decodeClassFile file + render (pp obj) 100 + putStrLn "" + diff --git a/src/test1.hs b/src/test1.hs new file mode 100644 --- /dev/null +++ b/src/test1.hs @@ -0,0 +1,43 @@ +module Main where +import Data.Binary +import Data.Bits + +fromBytes2Int :: [Int] -> Int +fromBytes2Int xs = fst $ foldr cons nil xs + where nil = (0, -8) + cons n (v,c) = (n =<<= (c+8) =|= v, c+8) + +-- foldr :: (a -> b -> b) -> b -> [a] -> b + +infixl 5 =<<=, =|= + +(=<<=) :: Int -> Int -> Int +a =<<= b = a `shiftL` b + +(=|=) :: Int -> Int -> Int +a =|= b = a .|. b + + +data Exp = IntE Int + | OpE String Exp Exp + deriving Show + +instance Binary Exp where + put (IntE i) = do put (0 :: Word8) + put i + put (OpE s e1 e2) = do put (1 :: Word8) + put s + put e1 + put e2 + + get = do t <- get :: Get Word8 + case t of + 0 -> do i <- get + return (IntE i) + 1 -> do s <- get + e1 <- get + e2 <- get + return (OpE s e1 e2) + +e = OpE "*" (IntE 7) (OpE "/" (IntE 4) (IntE 2)) + diff --git a/src/test2.hs b/src/test2.hs new file mode 100644 --- /dev/null +++ b/src/test2.hs @@ -0,0 +1,27 @@ +module Test where +import Jvm.Data.ClassFormat +import Jvm.BinaryClass + +example = + ClassFile + Magic + (MinorVersion 0) + (MajorVersion 50) + 1 -- count constant pool + [] -- constant pool + (AccessFlags [0]) -- access flags + (ThisClass 0) -- this + (SuperClass 0) -- super + 0 -- count intefaces + [] -- interfaces + 0 -- count fields + [] -- fields + 0 -- count methods + [] -- methods + 0 -- count attributes + [] -- attributes + +-- serializarlo +serializar = encodeClassFile "example.class" example + +