dbjava (empty) → 1.7
raw patch · 10 files changed
+1489/−0 lines, 10 filesdep +basedep +binarydep +bytestringsetup-changed
Dependencies added: base, binary, bytestring, haskell98, process, uulib
Files
- LICENSE +30/−0
- README +20/−0
- Setup.hs +6/−0
- dbjava.cabal +35/−0
- src/Jvm/BinaryClass.hs +518/−0
- src/Jvm/Data/ClassFormat.hs +281/−0
- src/Jvm/PrettyClass.hs +511/−0
- src/Main.hs +18/−0
- src/test1.hs +43/−0
- src/test2.hs +27/−0
+ LICENSE view
@@ -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.
+ README view
@@ -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+
+ Setup.hs view
@@ -0,0 +1,6 @@++import Distribution.Simple++main :: IO()+main = defaultMain+
+ dbjava.cabal view
@@ -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
+ src/Jvm/BinaryClass.hs view
@@ -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+
+ src/Jvm/Data/ClassFormat.hs view
@@ -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 + +
+ src/Jvm/PrettyClass.hs view
@@ -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)+
+ src/Main.hs view
@@ -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 ""+
+ src/test1.hs view
@@ -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))+
+ src/test2.hs view
@@ -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++