├── README.md ├── src └── Codec │ └── JVM │ ├── Field.hs │ ├── Cond.hs │ ├── ASM │ ├── Code │ │ ├── Types.hs │ │ ├── CtrlFlow.hs │ │ └── Instr.hs │ └── Code.hs │ ├── Internal.hs │ ├── Const.hs │ ├── Method.hs │ ├── Class.hs │ ├── ASM.hs │ ├── Attr.hs │ ├── ConstPool.hs │ ├── Types.hs │ └── Opcode.hs ├── stack.yaml ├── codec-jvm.cabal └── LICENSE /README.md: -------------------------------------------------------------------------------- 1 | codec-jvm 2 | ===== 3 | 4 | A JVM bytecode assembler written in Haskell. 5 | -------------------------------------------------------------------------------- /src/Codec/JVM/Field.hs: -------------------------------------------------------------------------------- 1 | module Codec.JVM.Field where 2 | 3 | -- https://docs.oracle.com/javase/specs/jvms/se8/html/jvms-4.html#jvms-4.5 4 | newtype FieldInfo = FieldInfo () 5 | deriving Show 6 | -------------------------------------------------------------------------------- /src/Codec/JVM/Cond.hs: -------------------------------------------------------------------------------- 1 | module Codec.JVM.Cond where 2 | 3 | -- | Condition 4 | 5 | data Cond 6 | = EQ 7 | | NE 8 | deriving (Eq, Ord, Show) 9 | {-- 10 | | LT 11 | | LE 12 | | GT 13 | | GE 14 | --} 15 | 16 | -------------------------------------------------------------------------------- /src/Codec/JVM/ASM/Code/Types.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE GeneralizedNewtypeDeriving #-} 2 | module Codec.JVM.ASM.Code.Types where 3 | 4 | import Codec.JVM.ASM.Code.CtrlFlow (CtrlFlow) 5 | 6 | import Data.IntMap.Strict (IntMap) 7 | 8 | newtype Offset = Offset Int -- absolute 9 | deriving (Num, Show) 10 | 11 | newtype StackMapTable = StackMapTable (IntMap CtrlFlow) 12 | deriving Monoid 13 | 14 | -------------------------------------------------------------------------------- /src/Codec/JVM/Internal.hs: -------------------------------------------------------------------------------- 1 | module Codec.JVM.Internal where 2 | 3 | import Data.Binary.Put (Put, putWord16be, putWord32be) 4 | import Data.Bits (shiftR) 5 | import Data.ByteString (ByteString) 6 | import Data.Word (Word8, Word16, Word32) 7 | 8 | import qualified Data.ByteString as BS 9 | 10 | packWord16be :: Word16 -> ByteString 11 | packWord16be w = BS.pack 12 | [ fromIntegral (shiftR w 8) :: Word8 13 | , fromIntegral (w) :: Word8 ] 14 | 15 | packWord32be :: Word32 -> ByteString 16 | packWord32be w = BS.pack 17 | [ fromIntegral (shiftR w 24) :: Word8 18 | , fromIntegral (shiftR w 16) :: Word8 19 | , fromIntegral (shiftR w 8) :: Word8 20 | , fromIntegral (w) :: Word8 ] 21 | 22 | packI16 :: Int -> ByteString 23 | packI16 = packWord16be . fromIntegral 24 | 25 | packI32 :: Int -> ByteString 26 | packI32 = packWord32be . fromIntegral 27 | 28 | putI16 :: Int -> Put 29 | putI16 = putWord16be . fromIntegral 30 | 31 | putI32 :: Int -> Put 32 | putI32 = putWord32be . fromIntegral 33 | -------------------------------------------------------------------------------- /stack.yaml: -------------------------------------------------------------------------------- 1 | # For more information, see: http://docs.haskellstack.org/en/stable/yaml_configuration.html 2 | 3 | # Specifies the GHC version and set of packages available (e.g., lts-3.5, nightly-2015-09-21, ghc-7.10.2) 4 | resolver: lts-5.7 5 | 6 | # Local packages, usually specified by relative directory name 7 | packages: 8 | - '.' 9 | 10 | # Packages to be pulled from upstream that are not in the resolver (e.g., acme-missiles-0.3) 11 | extra-deps: [] 12 | 13 | # Override default flag values for local packages and extra-deps 14 | flags: {} 15 | 16 | # Extra package databases containing global packages 17 | extra-package-dbs: [] 18 | 19 | # Control whether we use the GHC we find on the path 20 | # system-ghc: true 21 | 22 | # Require a specific version of stack, using version ranges 23 | # require-stack-version: -any # Default 24 | # require-stack-version: >= 1.0.0 25 | 26 | # Override the architecture used by stack, especially useful on Windows 27 | # arch: i386 28 | # arch: x86_64 29 | 30 | # Extra directories used by stack for building 31 | # extra-include-dirs: [/path/to/dir] 32 | # extra-lib-dirs: [/path/to/dir] 33 | 34 | # Allow a newer minor version of GHC than the snapshot specifies 35 | # compiler-check: newer-minor 36 | -------------------------------------------------------------------------------- /src/Codec/JVM/Const.hs: -------------------------------------------------------------------------------- 1 | module Codec.JVM.Const where 2 | 3 | import Data.Text (Text) 4 | import Data.Word (Word8) 5 | 6 | import Codec.JVM.Types (IClassName, FieldRef, FieldType(..), MethodRef, PrimType(..), NameAndDesc, jlString) 7 | 8 | constTag :: Const -> Word8 9 | constTag (CUTF8 _) = 1 10 | constTag (CValue (CInteger _)) = 3 11 | constTag (CClass _) = 7 12 | constTag (CValue (CString _)) = 8 13 | constTag (CFieldRef _) = 9 14 | constTag (CMethodRef _) = 10 15 | constTag (CNameAndType _) = 12 16 | 17 | -- | https://docs.oracle.com/javase/specs/jvms/se8/html/jvms-4.html#jvms-4.4 18 | data Const 19 | = CUTF8 Text 20 | | CValue ConstVal 21 | | CClass IClassName 22 | | CFieldRef FieldRef 23 | | CMethodRef MethodRef 24 | | CNameAndType NameAndDesc 25 | deriving (Eq, Ord, Show) 26 | 27 | -- | https://docs.oracle.com/javase/specs/jvms/se8/html/jvms-4.html#jvms-4.7.2-300-C.1 28 | data ConstVal 29 | = CInteger Int 30 | | CString Text 31 | deriving (Eq, Ord) 32 | 33 | instance Show ConstVal where 34 | show (CInteger x) = show x -- concat ["Int ", show x] 35 | show (CString x) = show x -- concat ["String ", show x] 36 | 37 | constValType :: ConstVal -> FieldType 38 | constValType (CInteger _) = BaseType JInt 39 | constValType (CString _) = ObjectType jlString 40 | -------------------------------------------------------------------------------- /codec-jvm.cabal: -------------------------------------------------------------------------------- 1 | name: codec-jvm 2 | version: 0 3 | license: Apache-2.0 4 | license-file: LICENSE 5 | author: Alois Cochard 6 | maintainer: alois.cochard@gmail.com 7 | copyright: Copyright (c) 2015 Alois Cochard 8 | category: Development 9 | build-type: Simple 10 | cabal-version: >=1.10 11 | 12 | library 13 | default-language: Haskell2010 14 | hs-source-dirs: src 15 | ghc-options: -Wall 16 | exposed-modules: 17 | Codec.JVM.ASM 18 | Codec.JVM.ASM.Code 19 | Codec.JVM.ASM.Code.CtrlFlow 20 | Codec.JVM.ASM.Code.Instr 21 | Codec.JVM.ASM.Code.Types 22 | Codec.JVM.Attr 23 | Codec.JVM.Class 24 | Codec.JVM.Cond 25 | Codec.JVM.Const 26 | Codec.JVM.ConstPool 27 | Codec.JVM.Field 28 | Codec.JVM.Internal 29 | Codec.JVM.Method 30 | Codec.JVM.Opcode 31 | Codec.JVM.Types 32 | build-depends: 33 | base >= 4.6.0.1 && < 5 34 | , base16-bytestring >= 0.1 && < 0.2 35 | , binary >= 0.7 && < 0.8 36 | , bytestring >= 0.10 && < 0.11 37 | , containers >= 0.5 && < 0.6 38 | , text >= 1.2 && < 1.3 39 | , transformers >= 0.4 && < 0.5 40 | -------------------------------------------------------------------------------- /src/Codec/JVM/ASM/Code/CtrlFlow.hs: -------------------------------------------------------------------------------- 1 | module Codec.JVM.ASM.Code.CtrlFlow where 2 | 3 | import Codec.JVM.Types (FieldType, fieldSize) 4 | import Data.IntMap.Strict as IntMap 5 | import Data.Word (Word8) 6 | 7 | data CtrlFlow = CtrlFlow 8 | { stack :: Stack 9 | , locals :: IntMap FieldType } 10 | deriving (Eq, Show) 11 | 12 | empty :: CtrlFlow 13 | empty = CtrlFlow mempty mempty 14 | 15 | equiv :: CtrlFlow -> CtrlFlow -> Bool 16 | equiv cf0 cf1 = (locals cf0 == locals cf1) && (stackVal $ stack cf0) == (stackVal $ stack cf1) 17 | 18 | mapStack :: (Stack -> Stack) -> CtrlFlow -> CtrlFlow 19 | mapStack f cf = cf { stack = f $ stack cf } 20 | 21 | maxStack :: CtrlFlow -> Int 22 | maxStack = stackMax . stack 23 | 24 | maxLocals :: CtrlFlow -> Int 25 | maxLocals = maybe 0 (succ . fst . fst) . IntMap.maxViewWithKey . locals 26 | 27 | load :: Word8 -> FieldType -> CtrlFlow -> CtrlFlow 28 | load n ft cf = cf { locals = IntMap.insert (fromIntegral n) ft $ locals cf, stack = push ft $ stack cf } 29 | 30 | store :: Word8 -> FieldType -> CtrlFlow -> CtrlFlow 31 | store n ft cf = cf { locals = IntMap.insert (fromIntegral n) ft $ locals cf, stack = pop ft $ stack cf } 32 | 33 | data Stack = Stack 34 | { stackVal :: [FieldType] 35 | , stackMax :: Int } 36 | deriving (Eq, Show) 37 | 38 | instance Monoid Stack where 39 | mempty = Stack [] 0 40 | mappend (Stack vs0 m0) (Stack vs1 m1) = Stack (vs1 ++ vs0) (max m0 m1) 41 | 42 | push :: FieldType -> Stack -> Stack 43 | push ft (Stack xs i) = Stack ys (max i $ sum $ fieldSize <$> ys) where ys = ft:xs 44 | 45 | pop :: FieldType -> Stack -> Stack 46 | pop ft = pop' $ fieldSize ft 47 | 48 | pop' :: Int -> Stack -> Stack 49 | pop' s (Stack xs i) = Stack (drop s xs) i 50 | -------------------------------------------------------------------------------- /src/Codec/JVM/Method.hs: -------------------------------------------------------------------------------- 1 | module Codec.JVM.Method where 2 | 3 | import Data.Binary.Put (Put, putWord16be) 4 | import Data.Set (Set) 5 | import Data.Word (Word16) 6 | 7 | import qualified Data.List as L 8 | import qualified Data.Set as S 9 | 10 | import Codec.JVM.Attr (Attr, putAttr, unpackAttr) 11 | import Codec.JVM.Const (Const(CUTF8)) 12 | import Codec.JVM.ConstPool (ConstPool, putIx) 13 | import Codec.JVM.Internal (putI16) 14 | import Codec.JVM.Types 15 | 16 | 17 | -- https://docs.oracle.com/javase/specs/jvms/se8/html/jvms-4.html#jvms-4.6 18 | 19 | data MethodInfo = MethodInfo 20 | { accessFlags :: Set AccessFlag 21 | , name :: UName 22 | , descriptor :: Desc 23 | , attributes :: [Attr] } 24 | deriving Show 25 | 26 | unpackMethodInfo :: MethodInfo -> [Const] 27 | unpackMethodInfo mi = unpackAttr =<< attributes mi 28 | 29 | -- https://docs.oracle.com/javase/specs/jvms/se8/html/jvms-4.html#jvms-4.6-200-A.1 30 | data AccessFlag 31 | = Public 32 | | Private 33 | | Protected 34 | | Static 35 | | Final 36 | | Synchronized 37 | | Bridge 38 | | VarArgs 39 | | Native 40 | | Abstract 41 | | Strict 42 | | Synthetic 43 | deriving (Eq, Ord, Show) 44 | 45 | accessFlagValue :: AccessFlag -> Word16 46 | accessFlagValue Public = 0x0001 47 | accessFlagValue Private = 0x0002 48 | accessFlagValue Protected = 0x0004 49 | accessFlagValue Static = 0x0008 50 | accessFlagValue Final = 0x0010 51 | accessFlagValue Synchronized = 0x0020 52 | accessFlagValue Bridge = 0x0040 53 | accessFlagValue VarArgs = 0x0080 54 | accessFlagValue Native = 0x0100 55 | accessFlagValue Abstract = 0x0400 56 | accessFlagValue Strict = 0x0800 57 | accessFlagValue Synthetic = 0x1000 58 | 59 | putMethodInfo :: ConstPool -> MethodInfo -> Put 60 | putMethodInfo cp mi = do 61 | putWord16be $ foldr (+) 0 (accessFlagValue <$> (S.toList $ accessFlags mi)) 62 | case name mi of UName n -> putIx cp $ CUTF8 n 63 | case descriptor mi of Desc d -> putIx cp $ CUTF8 d 64 | putI16 . L.length $ attributes mi 65 | mapM_ (putAttr cp) $ attributes mi 66 | -------------------------------------------------------------------------------- /src/Codec/JVM/Class.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings #-} 2 | module Codec.JVM.Class where 3 | 4 | import Data.ByteString.Base16 (decode) 5 | import Data.ByteString (ByteString) 6 | import Data.Binary.Put (Put, putByteString, putWord16be) 7 | import Data.Maybe (fromMaybe) 8 | import Data.Set (Set) 9 | import Data.Word (Word16) 10 | 11 | import qualified Data.List as L 12 | import qualified Data.Set as S 13 | 14 | import Codec.JVM.Attr (Attr) 15 | import Codec.JVM.Const (Const(CClass)) 16 | import Codec.JVM.ConstPool (ConstPool, putConstPool, putIx) 17 | import Codec.JVM.Field (FieldInfo) 18 | import Codec.JVM.Internal (putI16) 19 | import Codec.JVM.Method (MethodInfo, putMethodInfo) 20 | import Codec.JVM.Types (Version, IClassName, jlObject, versionMaj, versionMin) 21 | import qualified Codec.JVM.ConstPool as CP 22 | 23 | -- https://docs.oracle.com/javase/specs/jvms/se8/html/jvms-4.html#jvms-4.1 24 | data ClassFile = ClassFile 25 | { constPool :: ConstPool 26 | , version :: Version 27 | , accessFlags :: Set AccessFlag 28 | , thisClass :: IClassName 29 | , superClass :: Maybe IClassName 30 | , interfaces :: [IClassName] 31 | , fields :: [FieldInfo] 32 | , methods :: [MethodInfo] 33 | , attributes :: [Attr] } 34 | deriving Show 35 | 36 | -- https://docs.oracle.com/javase/specs/jvms/se8/html/jvms-4.html#jvms-4.1-200-E.1 37 | data AccessFlag 38 | = Public 39 | | Final 40 | | Super 41 | | Interface 42 | | Abstract 43 | | Synthetic 44 | | Annotation 45 | | Enum 46 | deriving (Eq, Ord, Show) 47 | 48 | accessFlagValue :: AccessFlag -> Word16 49 | accessFlagValue Public = 0x0001 50 | accessFlagValue Final = 0x0010 51 | accessFlagValue Super = 0x0020 52 | accessFlagValue Interface = 0x0200 53 | accessFlagValue Abstract = 0x0400 54 | accessFlagValue Synthetic = 0x1000 55 | accessFlagValue Annotation = 0x2000 56 | accessFlagValue Enum = 0x4000 57 | 58 | magic :: ByteString 59 | magic = fst . decode $ "CAFEBABE" 60 | 61 | putClassFile :: ClassFile -> Put 62 | putClassFile cf = do 63 | putByteString magic 64 | putI16 . versionMin . version $ cf 65 | putI16 . versionMaj . version $ cf 66 | putI16 . (+) 1 . CP.size . constPool $ cf 67 | putConstPool cp 68 | putWord16be $ foldr (+) 0 (accessFlagValue <$> (S.toList $ accessFlags cf)) 69 | putIx cp $ CClass $ thisClass cf 70 | putIx cp $ CClass $ fromMaybe jlObject $ superClass cf 71 | putI16 0 -- TODO Interfaces 72 | putI16 0 -- TODO Fields 73 | putMethods 74 | putI16 0 -- TODO Attributes 75 | return () where 76 | cp = constPool cf 77 | putMethods = do 78 | putI16 . L.length $ methods cf 79 | mapM_ (putMethodInfo cp) $ methods cf 80 | 81 | -------------------------------------------------------------------------------- /src/Codec/JVM/ASM.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings #-} 2 | ----------------------------------------------------------------------------- 3 | -- | Usage: 4 | -- 5 | -- You can assemble a java class: 6 | -- 7 | -- @ 8 | -- {-# LANGUAGE OverloadedStrings #-} 9 | -- import Data.Binary.Put (runPut) 10 | -- import Data.Foldable (fold) 11 | -- import qualified Data.ByteString.Lazy as BS 12 | -- 13 | -- import Codec.JVM.ASM (mkClassFile, mkMethodDef) 14 | -- import Codec.JVM.ASM.Code 15 | -- import Codec.JVM.Class (ClassFile, putClassFile) 16 | -- import Codec.JVM.Method (AccessFlag(..)) 17 | -- import Codec.JVM.Types 18 | -- 19 | -- mainClass :: ClassFile 20 | -- mainClass = mkClassFile java8 [] "HelloWorld" Nothing 21 | -- [ mkMethodDef [Public, Static] "main" [arr.obj $ "java/lang/String"] void $ fold 22 | -- [ getstatic systemOut 23 | -- , bipush jInt 42 24 | -- , invokevirtual printlnI 25 | -- , vreturn ] 26 | -- ] 27 | -- where 28 | -- systemOut = mkFieldRef "java/lang/System" "out" (obj "java/io/PrintStream") 29 | -- printlnI = mkMethodRef "java/io/PrintStream" "println" [prim JInt] void 30 | -- 31 | -- main :: IO () 32 | -- main = BS.writeFile "HelloWorld.class" $ runPut . putClassFile $ mainClass 33 | -- @ 34 | -- 35 | module Codec.JVM.ASM where 36 | 37 | import Data.Maybe (fromMaybe) 38 | import Data.Text (Text) 39 | 40 | import qualified Data.Set as Set 41 | 42 | import Codec.JVM.ASM.Code (Code) 43 | import Codec.JVM.Class (ClassFile(..)) 44 | import Codec.JVM.Const (Const(..)) 45 | import Codec.JVM.ConstPool (mkConstPool) 46 | import Codec.JVM.Method (MethodInfo(..)) 47 | import Codec.JVM.Types 48 | 49 | import qualified Codec.JVM.ASM.Code as Code 50 | import qualified Codec.JVM.Class as Class 51 | import qualified Codec.JVM.Method as Method 52 | import qualified Codec.JVM.ConstPool as CP 53 | 54 | mkClassFile :: Version -> [Class.AccessFlag] -> IClassName -> Maybe IClassName -> [MethodDef] -> ClassFile 55 | mkClassFile v afs tc sc mds = ClassFile cp v (Set.fromList afs) tc sc [] [] mis [] 56 | where 57 | cs = ccs ++ mdcs ++ mics where 58 | ccs = concat [CP.unpackClassName tc, CP.unpackClassName $ fromMaybe jlObject sc] 59 | mdcs = mds >>= unpackMethodDef 60 | mics = mis >>= Method.unpackMethodInfo 61 | cp = mkConstPool cs 62 | mis = f <$> mds where 63 | f (MethodDef afs' n' (MethodDesc d as) code) = 64 | MethodInfo (Set.fromList afs') n' (Desc d) $ Code.toAttrs as cp code 65 | 66 | data MethodDef = MethodDef [Method.AccessFlag] UName MethodDesc Code 67 | 68 | mkMethodDef :: [Method.AccessFlag] -> Text -> [FieldType] -> ReturnType -> Code -> MethodDef 69 | mkMethodDef afs n fts rt c = mkMethodDef' afs n (mkMethodDesc fts rt) c 70 | 71 | mkMethodDef' :: [Method.AccessFlag] -> Text -> MethodDesc -> Code -> MethodDef 72 | mkMethodDef' afs n md c = MethodDef afs (UName n) md c 73 | 74 | unpackMethodDef :: MethodDef -> [Const] 75 | unpackMethodDef (MethodDef _ (UName n') (MethodDesc d _) code) = CUTF8 n':CUTF8 d:Code.consts code 76 | -------------------------------------------------------------------------------- /src/Codec/JVM/Attr.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings #-} 2 | module Codec.JVM.Attr where 3 | 4 | import Data.ByteString (ByteString) 5 | import Data.Binary.Put (Put, putByteString, putWord8, runPut) 6 | import Data.Foldable (traverse_) 7 | import Data.IntMap.Strict (IntMap) 8 | import Data.Text (Text) 9 | import Data.List (foldl') 10 | 11 | import qualified Data.ByteString as BS 12 | import qualified Data.ByteString.Lazy as LBS 13 | import qualified Data.IntMap.Strict as IntMap 14 | import qualified Data.Text as Text 15 | 16 | import Codec.JVM.ASM.Code.Types (Offset(..)) 17 | import Codec.JVM.Const (Const(CUTF8)) 18 | import Codec.JVM.ConstPool (ConstPool, putIx) 19 | import Codec.JVM.Internal (putI16, putI32) 20 | import Codec.JVM.Types (PrimType(..), FieldType(..)) 21 | 22 | data Attr 23 | = ACode 24 | { maxStack :: Int 25 | , maxLocals :: Int 26 | , code :: ByteString 27 | , codeAttrs :: [Attr] } 28 | | AStackMapTable [(Offset, StackMapFrame)] 29 | 30 | instance Show Attr where 31 | show attr = "A" ++ (Text.unpack $ attrName attr) 32 | 33 | attrName :: Attr -> Text 34 | attrName (ACode _ _ _ _) = "Code" 35 | attrName (AStackMapTable _) = "StackMapTable" 36 | 37 | unpackAttr :: Attr -> [Const] 38 | unpackAttr attr@(ACode _ _ _ xs) = (CUTF8 $ attrName attr):(unpackAttr =<< xs) 39 | unpackAttr attr = return . CUTF8 . attrName $ attr 40 | 41 | putAttr :: ConstPool -> Attr -> Put 42 | putAttr cp attr = do 43 | putIx cp $ CUTF8 $ attrName attr 44 | let xs = runPut $ putAttrBody cp attr 45 | putI32 . fromIntegral $ LBS.length xs 46 | putByteString $ LBS.toStrict xs 47 | 48 | putAttrBody :: ConstPool -> Attr -> Put 49 | putAttrBody cp (ACode ms ls xs attrs) = do 50 | putI16 ms 51 | putI16 ls 52 | putI32 . fromIntegral $ BS.length xs 53 | putByteString xs 54 | putI16 0 -- TODO Exception table 55 | putI16 $ length attrs 56 | mapM_ (putAttr cp) attrs 57 | putAttrBody _ (AStackMapTable xs) = do 58 | putI16 $ length xs 59 | putStackMapFrames xs 60 | 61 | -- | http://docs.oracle.com/javase/specs/jvms/se8/html/jvms-4.html#jvms-4.7.4 62 | -- 63 | -- Offsets are absolute (the delta conversion happen during serialization) 64 | 65 | data StackMapFrame 66 | = SameFrame 67 | | SameLocals VerifType 68 | | FullFrame [VerifType] [VerifType] 69 | deriving (Eq, Show) 70 | 71 | putStackMapFrames :: [(Offset, StackMapFrame)] -> Put 72 | putStackMapFrames xs = snd $ foldl' f ((0, return ())) xs where 73 | f (offset, put) (Offset frameOffset, frame) = (frameOffset, put *> putFrame frame) where 74 | delta = fromIntegral $ frameOffset - if offset == 0 then 0 else offset + 1 75 | putFrame SameFrame = 76 | putWord8 $ delta 77 | putFrame (SameLocals vt) = do 78 | putWord8 $ delta + 64 79 | putVerifType vt 80 | putFrame (FullFrame locals stack) = do 81 | putWord8 255 82 | putI16 $ fromIntegral delta 83 | putI16 $ length locals 84 | traverse_ putVerifType locals 85 | putI16 $ length stack 86 | traverse_ putVerifType stack 87 | 88 | newtype VerifType = VerifType FieldType 89 | deriving (Eq, Show) 90 | 91 | putVerifType :: VerifType -> Put 92 | putVerifType (VerifType (BaseType JInt)) = putWord8 1 93 | -------------------------------------------------------------------------------- /src/Codec/JVM/ConstPool.hs: -------------------------------------------------------------------------------- 1 | module Codec.JVM.ConstPool where 2 | 3 | import Control.Monad (join) 4 | import Data.Binary.Put (Put, putByteString, putWord8, putWord16be) 5 | import Data.Map.Strict (Map) 6 | import Data.Text.Encoding (encodeUtf8) 7 | 8 | import qualified Data.List as L 9 | import qualified Data.Map.Strict as M 10 | import qualified Data.Text as T 11 | 12 | import Codec.JVM.Const 13 | import Codec.JVM.Internal (putI16, putI32) 14 | import Codec.JVM.Types 15 | 16 | newtype CIx = CIx Int 17 | 18 | newtype ConstPool = ConstPool (Map Const Int) 19 | deriving Show 20 | 21 | mkConstPool :: [Const] -> ConstPool 22 | mkConstPool defs = ConstPool . snd $ L.foldl' f (0, M.empty) defs where 23 | f acc c = L.foldl' f' acc $ unpack c where 24 | f' (i, xs) y = if M.member y xs then (i, xs) else (i + 1, M.insert y i xs) 25 | 26 | run :: ConstPool -> [Const] 27 | run (ConstPool xs) = fmap fst $ L.sortOn snd $ M.toList xs 28 | 29 | size :: ConstPool -> Int 30 | size (ConstPool xs) = M.size xs 31 | 32 | index :: Const -> ConstPool -> Maybe CIx 33 | index def (ConstPool xs) = CIx . (+) 1 <$> M.lookup def xs 34 | 35 | ix :: CIx -> Int 36 | ix (CIx x) = x 37 | 38 | unsafeIndex :: Const -> ConstPool -> CIx 39 | unsafeIndex def cp = maybe (error $ join ["Constant '", show def, "'not found."]) id $ index def cp 40 | 41 | unpack :: Const -> [Const] 42 | unpack (CClass cn) = unpackClassName cn 43 | unpack c@(CValue (CString str)) = [c, CUTF8 str] 44 | unpack (CFieldRef ref) = unpackFieldRef ref 45 | unpack (CMethodRef ref) = unpackMethodRef ref 46 | unpack (CNameAndType nd) = unpackNameAndType nd 47 | unpack c = [c] 48 | 49 | unpackClassName :: IClassName -> [Const] 50 | unpackClassName cn@(IClassName str) = [CClass cn, CUTF8 str] 51 | 52 | unpackFieldDesc :: UName -> FieldDesc -> [Const] 53 | unpackFieldDesc n (FieldDesc t) = unpackNameAndType (NameAndDesc n $ Desc t) 54 | 55 | unpackFieldRef :: FieldRef -> [Const] 56 | unpackFieldRef ref@(FieldRef cn n ft) = 57 | CFieldRef ref:unpackClassName cn ++ unpackFieldDesc n (mkFieldDesc ft) 58 | 59 | unpackMethodRef :: MethodRef -> [Const] 60 | unpackMethodRef ref@(MethodRef cn n fts rt) = 61 | CMethodRef ref:unpackClassName cn ++ unpackNameAndType (NameAndDesc n $ Desc (mkMethodDesc' fts rt)) 62 | 63 | unpackNameAndType :: NameAndDesc -> [Const] 64 | unpackNameAndType nd@(NameAndDesc (UName str0) (Desc str1)) = [CNameAndType nd, CUTF8 str0, CUTF8 str1] 65 | 66 | putIx :: ConstPool -> Const -> Put 67 | putIx cp c = putWord16be . fromIntegral . ix $ unsafeIndex c cp 68 | 69 | putConstPool :: ConstPool -> Put 70 | putConstPool cp = mapM_ putConst $ run cp where 71 | putConst c = do 72 | putWord8 . constTag $ c 73 | case c of 74 | (CUTF8 str) -> do 75 | putI16 (T.length str) 76 | putByteString $ encodeUtf8 str 77 | (CValue (CInteger i)) -> 78 | putI32 i 79 | (CValue (CString str)) -> 80 | putIx' $ CUTF8 str 81 | (CClass (IClassName str)) -> 82 | putIx' $ CUTF8 str 83 | (CFieldRef (FieldRef cn n ft)) -> do 84 | putRef cn n $ mkFieldDesc' ft 85 | (CMethodRef (MethodRef cn n fts rt)) -> 86 | putRef cn n $ mkMethodDesc' fts rt 87 | (CNameAndType (NameAndDesc (UName n) (Desc d))) -> do 88 | putIx' $ CUTF8 n 89 | putIx' $ CUTF8 d 90 | where 91 | putRef cn n d = do 92 | putIx' $ CClass cn 93 | putIx' . CNameAndType $ NameAndDesc n (Desc d) 94 | putIx' = putIx cp 95 | 96 | 97 | -------------------------------------------------------------------------------- /src/Codec/JVM/Types.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE GeneralizedNewtypeDeriving #-} 2 | {-# LANGUAGE OverloadedStrings #-} 3 | module Codec.JVM.Types where 4 | 5 | import Data.Foldable (fold) 6 | import Data.Text (Text) 7 | import Data.String (IsString) 8 | 9 | import qualified Data.Text as Text 10 | 11 | data PrimType 12 | = JByte 13 | | JChar 14 | | JDouble 15 | | JFloat 16 | | JInt 17 | | JLong 18 | | JShort 19 | | JBool 20 | deriving (Eq, Ord, Show) 21 | 22 | jInt :: FieldType 23 | jInt = BaseType JInt 24 | 25 | jString :: FieldType 26 | jString = ObjectType jlString 27 | 28 | jlObject :: IClassName 29 | jlObject = IClassName "java/lang/Object" 30 | 31 | jlString :: IClassName 32 | jlString = IClassName "java/lang/String" 33 | 34 | -- | Binary class names in their internal form. 35 | -- https://docs.oracle.com/javase/specs/jvms/se8/html/jvms-4.html#jvms-4.2.1 36 | newtype IClassName = IClassName Text 37 | deriving (Eq, Ord, Show, IsString) 38 | 39 | -- | Unqualified name 40 | -- https://docs.oracle.com/javase/specs/jvms/se8/html/jvms4.html#jvms-4.2.2 41 | newtype UName = UName Text 42 | deriving (Eq, Ord, Show, IsString) 43 | 44 | -- | Field descriptor 45 | -- https://docs.oracle.com/javase/specs/jvms/se8/html/jvms-4.html#jvms-4.3.2 46 | newtype FieldDesc = FieldDesc Text 47 | deriving (Eq, Ord, Show) 48 | 49 | data FieldType = BaseType PrimType | ObjectType IClassName | ArrayType FieldType 50 | deriving (Eq, Ord, Show) 51 | 52 | mkFieldDesc :: FieldType -> FieldDesc 53 | mkFieldDesc ft = FieldDesc $ mkFieldDesc' ft where 54 | 55 | mkFieldDesc' :: FieldType -> Text 56 | mkFieldDesc' ft = case ft of 57 | BaseType JByte -> "B" 58 | BaseType JChar -> "C" 59 | BaseType JDouble -> "D" 60 | BaseType JFloat -> "F" 61 | BaseType JInt -> "I" 62 | BaseType JLong -> "J" 63 | BaseType JShort -> "S" 64 | BaseType JBool -> "Z" 65 | ObjectType (IClassName cn) -> fold ["L", cn, ";"] 66 | ArrayType ft' -> Text.concat ["[", mkFieldDesc' ft'] 67 | 68 | fieldSize :: FieldType -> Int 69 | fieldSize (BaseType JLong) = 2 70 | fieldSize (BaseType JDouble) = 2 71 | fieldSize (BaseType JFloat) = 2 72 | fieldSize (ObjectType _ ) = 2 73 | fieldSize (ArrayType _) = 2 74 | fieldSize _ = 1 75 | 76 | prim :: PrimType -> FieldType 77 | prim = BaseType 78 | 79 | obj :: Text -> FieldType 80 | obj = ObjectType . IClassName 81 | 82 | arr :: FieldType -> FieldType 83 | arr = ArrayType 84 | 85 | data MethodType = MethodType [FieldType] ReturnType 86 | 87 | type ReturnType = Maybe FieldType 88 | 89 | void :: ReturnType 90 | void = Nothing 91 | 92 | -- | Method descriptor 93 | -- https://docs.oracle.com/javase/specs/jvms/se8/html/jvms-4.html#jvms-4.3.3 94 | data MethodDesc = MethodDesc Text Int -- number of arguments 95 | deriving (Eq, Ord, Show) 96 | 97 | mkMethodDesc :: [FieldType] -> ReturnType -> MethodDesc 98 | mkMethodDesc fts rt = MethodDesc (mkMethodDesc' fts rt) (length fts) 99 | 100 | mkMethodDesc' :: [FieldType] -> ReturnType -> Text 101 | mkMethodDesc' fts rt = Text.concat ["(", args, ")", ret] where 102 | args = Text.concat $ mkFieldDesc' <$> fts 103 | ret = maybe "V" mkFieldDesc' rt 104 | 105 | -- | Field or method reference 106 | -- https://docs.oracle.com/javase/specs/jvms/se8/html/jvms-4.html#jvms-4.4.2 107 | 108 | data FieldRef = FieldRef IClassName UName FieldType 109 | deriving (Eq, Ord, Show) 110 | 111 | mkFieldRef :: IClassName -> UName -> FieldType -> FieldRef 112 | mkFieldRef cn un ft = FieldRef cn un ft 113 | 114 | data MethodRef = MethodRef IClassName UName [FieldType] ReturnType 115 | deriving (Eq, Ord, Show) 116 | 117 | mkMethodRef :: IClassName -> UName -> [FieldType] -> ReturnType -> MethodRef 118 | mkMethodRef cn un fts rt = MethodRef cn un fts rt 119 | 120 | data NameAndDesc = NameAndDesc UName Desc 121 | deriving (Eq, Ord, Show) 122 | 123 | -- | Field or method descriptor 124 | newtype Desc = Desc Text 125 | deriving (Eq, Ord, Show) 126 | 127 | data Version = Version 128 | { versionMaj :: Int 129 | , versionMin :: Int } 130 | deriving (Eq, Ord, Show) 131 | 132 | java8 :: Version 133 | java8 = Version 52 0 134 | 135 | -------------------------------------------------------------------------------- /src/Codec/JVM/ASM/Code/Instr.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE GeneralizedNewtypeDeriving #-} 2 | module Codec.JVM.ASM.Code.Instr where 3 | 4 | import Control.Monad.Trans.RWS 5 | import Data.ByteString (ByteString) 6 | import Data.IntMap.Strict (IntMap) 7 | import Data.Monoid ((<>)) 8 | 9 | import qualified Data.ByteString as BS 10 | import qualified Data.IntMap.Strict as IntMap 11 | 12 | import Codec.JVM.ASM.Code.CtrlFlow (CtrlFlow, Stack) 13 | import Codec.JVM.ASM.Code.Types (Offset(..), StackMapTable(..)) 14 | import Codec.JVM.Attr (StackMapFrame(..), VerifType(..)) 15 | import Codec.JVM.Cond (Cond) 16 | import Codec.JVM.Const (Const) 17 | import Codec.JVM.Internal (packI16) 18 | import Codec.JVM.Opcode (Opcode, opcode) 19 | import Codec.JVM.ConstPool (ConstPool) 20 | import Codec.JVM.Types (ReturnType, jInt) 21 | 22 | import qualified Codec.JVM.ASM.Code.CtrlFlow as CF 23 | import qualified Codec.JVM.Cond as CD 24 | import qualified Codec.JVM.ConstPool as CP 25 | import qualified Codec.JVM.Opcode as OP 26 | 27 | type InstrRWS a = (RWS ConstPool (ByteString, StackMapTable) (Offset, CtrlFlow) a) 28 | 29 | newtype Instr = Instr (InstrRWS ()) 30 | 31 | instrRWS :: Instr -> InstrRWS () 32 | instrRWS (Instr irws) = irws 33 | 34 | instance Monoid Instr where 35 | mempty = Instr $ return mempty 36 | mappend (Instr rws0) (Instr rws1) = Instr $ do 37 | rws0 38 | rws1 39 | 40 | runInstr :: Instr -> ConstPool -> (ByteString, CtrlFlow, StackMapTable) 41 | runInstr instr cp = runInstr' instr cp 0 CF.empty 42 | 43 | runInstr' :: Instr -> ConstPool -> Offset -> CtrlFlow -> (ByteString, CtrlFlow, StackMapTable) 44 | runInstr' (Instr instr) cp offset cf = f $ runRWS instr cp (offset, cf) where 45 | f (_, (_, cf'), (bs, smfs)) = (bs, cf', smfs) 46 | 47 | iif :: Cond -> Instr -> Instr -> Instr 48 | iif cond ok ko = Instr $ do 49 | lengthOp <- writeInstr ifop 50 | branches lengthOp 51 | where 52 | ifop = op oc <> (ctrlFlow $ CF.mapStack $ CF.pop jInt) where 53 | oc = case cond of 54 | CD.EQ -> OP.ifeq 55 | CD.NE -> OP.ifne 56 | branches :: Int -> InstrRWS () 57 | branches lengthOp = do 58 | (_, cf) <- get 59 | (koBytes, koCF, koFrames) <- pad 2 ko -- packI16 60 | writeBytes . packI16 $ BS.length koBytes + lengthJumpOK + lengthOp + 2 -- packI16 61 | write koBytes koFrames 62 | (okBytes, okCF, okFrames) <- pad lengthJumpOK ok 63 | op' OP.goto 64 | writeBytes . packI16 $ BS.length okBytes + 3 -- op goto <> packI16 $ length ok 65 | writeStackMapFrame 66 | write okBytes okFrames 67 | putCtrlFlow $ okCF 68 | { CF.locals = IntMap.union (CF.locals okCF) (CF.locals koCF) 69 | , CF.stack = (CF.stack okCF) { CF.stackMax = max (CF.stackMax $ CF.stack okCF) (CF.stackMax $ CF.stack koCF)} } 70 | writeStackMapFrame 71 | where 72 | pad padding instr = do 73 | cp <- ask 74 | (Offset offset, cf) <- get 75 | return $ runInstr' instr cp (Offset $ offset + padding) cf 76 | lengthKO = 0 77 | lengthJumpOK = 3 -- op goto <> pack16 $ length ko 78 | 79 | bytes :: ByteString -> Instr 80 | bytes = Instr . writeBytes 81 | 82 | ix :: Const -> Instr 83 | ix c = Instr $ do 84 | cp <- ask 85 | writeBytes . packI16 $ CP.ix $ CP.unsafeIndex c cp 86 | 87 | op :: Opcode -> Instr 88 | op = Instr . op' 89 | 90 | op' :: Opcode -> InstrRWS () 91 | op' = writeBytes . BS.singleton . opcode 92 | 93 | ctrlFlow :: (CtrlFlow -> CtrlFlow) -> Instr 94 | ctrlFlow f = Instr $ state s where s (off, cf) = (mempty, (off, f cf)) 95 | 96 | putCtrlFlow :: CtrlFlow -> InstrRWS () 97 | putCtrlFlow cf = do 98 | (off, _) <- get 99 | put (off, cf) 100 | 101 | incOffset :: Int -> Instr 102 | incOffset = Instr . incOffset' 103 | 104 | incOffset' :: Int -> InstrRWS () 105 | incOffset' i = state s where s (Offset off, cf) = (mempty, (Offset $ off + i, cf)) 106 | 107 | write :: ByteString -> StackMapTable-> InstrRWS () 108 | write bs smfs = do 109 | incOffset' $ BS.length bs 110 | tell (bs, smfs) 111 | 112 | writeBytes :: ByteString -> InstrRWS () 113 | writeBytes bs = write bs mempty 114 | 115 | writeInstr :: Instr -> InstrRWS Int 116 | writeInstr (Instr action) = do 117 | (Offset off0, _) <- get 118 | action 119 | (Offset off1, _) <- get 120 | return (off1 - off0) 121 | 122 | writeStackMapFrame :: InstrRWS () 123 | writeStackMapFrame = get >>= f where 124 | f (Offset offset, cf) = tell (mempty, StackMapTable $ IntMap.singleton offset cf) 125 | -------------------------------------------------------------------------------- /src/Codec/JVM/ASM/Code.hs: -------------------------------------------------------------------------------- 1 | module Codec.JVM.ASM.Code where 2 | 3 | import Data.ByteString (ByteString) 4 | import Data.Foldable (fold) 5 | import Data.List (foldl') 6 | import Data.Monoid ((<>)) 7 | import Data.Word (Word8, Word16) 8 | 9 | import qualified Data.ByteString as BS 10 | 11 | import Codec.JVM.ASM.Code.Instr (Instr, runInstr) 12 | import Codec.JVM.ASM.Code.Types (Offset(..), StackMapTable(..)) 13 | import Codec.JVM.Attr (Attr(ACode, AStackMapTable), StackMapFrame(..), VerifType(..)) 14 | import Codec.JVM.Cond (Cond) 15 | import Codec.JVM.Const (Const(..), ConstVal, constValType) 16 | import Codec.JVM.ConstPool (ConstPool) 17 | import Codec.JVM.Internal (packWord16be) 18 | import Codec.JVM.Opcode (Opcode) 19 | import Codec.JVM.Types 20 | 21 | import qualified Codec.JVM.ASM.Code.CtrlFlow as CF 22 | import qualified Codec.JVM.Cond as CD 23 | import qualified Codec.JVM.ASM.Code.Instr as IT 24 | import qualified Codec.JVM.ConstPool as CP 25 | import qualified Codec.JVM.Opcode as OP 26 | 27 | import qualified Data.IntMap.Strict as IntMap 28 | 29 | -- TODO Return `Either` with error (currently CF.pop is unsafe) 30 | toAttrs :: Int -> ConstPool -> Code -> [Attr] 31 | toAttrs as cp code = f $ runInstr (instr code) cp where 32 | f (xs, cf, smt) = [ACode maxStack' maxLocals' xs attrs] where 33 | maxLocals' = max as $ CF.maxLocals cf 34 | maxStack' = CF.maxStack cf 35 | attrs = if null frames then [] else [AStackMapTable frames] 36 | frames = toStackMapFrames smt 37 | 38 | -- TODO Optimization: For now we only generate Same or Full frames, we could encode better intermediate cases. 39 | toStackMapFrames :: StackMapTable -> [(Offset, StackMapFrame)] 40 | toStackMapFrames (StackMapTable cfs) = reverse (fst $ foldl' f ([], CF.empty) $ IntMap.toAscList cfs) where 41 | f (xs, last) (off, cf) = ((Offset off, smf):xs, cf) where 42 | smf = if CF.equiv last cf then SameFrame else fullFrame cf 43 | fullFrame cf = FullFrame lvts svts where 44 | lvts = fmap f $ IntMap.toList $ CF.locals cf where f (_, ft) = VerifType ft 45 | svts = fmap VerifType $ CF.stackVal $ CF.stack cf 46 | 47 | data Code = Code 48 | { consts :: [Const] 49 | , instr :: Instr } 50 | 51 | instance Monoid Code where 52 | mempty = Code mempty mempty 53 | mappend (Code cs0 i0) (Code cs1 i1) = Code (mappend cs0 cs1) (mappend i0 i1) 54 | 55 | mkCode :: [Const] -> Instr -> Code 56 | mkCode cs i = Code cs i 57 | 58 | mkCode' :: Instr -> Code 59 | mkCode' = mkCode [] 60 | 61 | codeConst :: Opcode -> FieldType -> Const -> Code 62 | codeConst oc ft c = mkCode cs $ fold 63 | [ IT.op oc 64 | , IT.ix c 65 | , IT.ctrlFlow $ CF.mapStack $ CF.push ft ] 66 | where cs = CP.unpack c 67 | 68 | codeBytes :: ByteString -> Code 69 | codeBytes bs = mkCode [] $ IT.bytes bs 70 | 71 | op :: Opcode -> Code 72 | op = mkCode' . IT.op 73 | 74 | pushBytes :: Opcode -> FieldType -> ByteString -> Code 75 | pushBytes oc ft bs = mkCode' $ fold 76 | [ IT.op oc 77 | , IT.bytes bs 78 | , IT.ctrlFlow $ CF.mapStack $ CF.push ft ] 79 | 80 | -- 81 | -- Operations 82 | -- 83 | 84 | bipush :: FieldType -> Word8 -> Code 85 | bipush ft w = pushBytes OP.bipush ft $ BS.singleton w 86 | 87 | sipush :: FieldType -> Word16 -> Code 88 | sipush ft w = pushBytes OP.sipush ft $ packWord16be w 89 | 90 | ldc :: ConstVal -> Code 91 | ldc cv = codeConst OP.ldc_w ft $ CValue cv where ft = constValType cv 92 | 93 | invoke :: Opcode -> MethodRef -> Code 94 | invoke oc mr@(MethodRef _ _ fts rt) = mkCode cs $ fold 95 | [ IT.op oc 96 | , IT.ix c 97 | , IT.ctrlFlow $ CF.mapStack $ CF.pop' (sum $ fieldSize <$> fts) <> maybe mempty CF.push rt ] 98 | where 99 | c = CMethodRef mr 100 | cs = CP.unpack c 101 | 102 | invokevirtual :: MethodRef -> Code 103 | invokevirtual = invoke OP.invokevirtual 104 | 105 | invokespecial :: MethodRef -> Code 106 | invokespecial = invoke OP.invokespecial 107 | 108 | invokestatic :: MethodRef -> Code 109 | invokestatic = invoke OP.invokestatic 110 | 111 | iadd :: Code 112 | iadd = mkCode' $ IT.op OP.iadd <> i where 113 | i = IT.ctrlFlow $ CF.mapStack $ CF.pop jInt <> CF.push jInt 114 | 115 | iif :: Cond -> Code -> Code -> Code 116 | iif cond ok ko = mkCode cs ins where 117 | cs = [ok, ko] >>= consts 118 | ins = IT.iif cond (instr ok) (instr ko) 119 | 120 | ifne :: Code -> Code -> Code 121 | ifne = iif CD.NE 122 | 123 | ifeq :: Code -> Code -> Code 124 | ifeq = iif CD.EQ 125 | 126 | iload :: Word8 -> Code 127 | iload n = mkCode' $ f n <> cf where 128 | f 0 = IT.op OP.iload_0 129 | f 1 = IT.op OP.iload_1 130 | f 2 = IT.op OP.iload_2 131 | f 3 = IT.op OP.iload_3 132 | f _ = fold [IT.op OP.iload, IT.bytes $ BS.singleton n] 133 | cf = IT.ctrlFlow $ CF.load n jInt 134 | 135 | ireturn :: Code 136 | ireturn = op OP.ireturn 137 | 138 | istore :: Word8 -> Code 139 | istore n = mkCode' $ f n <> cf where 140 | f 0 = IT.op OP.istore_0 141 | f 1 = IT.op OP.istore_1 142 | f 2 = IT.op OP.istore_2 143 | f 3 = IT.op OP.istore_3 144 | f _ = fold [IT.op OP.istore, IT.bytes $ BS.singleton n] 145 | cf = IT.ctrlFlow $ CF.store n jInt 146 | 147 | vreturn :: Code 148 | vreturn = op OP.vreturn 149 | 150 | getstatic :: FieldRef -> Code 151 | getstatic fr@(FieldRef _ _ ft) = codeConst OP.getstatic ft $ CFieldRef fr 152 | 153 | anewarray :: IClassName -> Code 154 | anewarray cn = codeConst OP.anewarray (ObjectType cn) $ CClass cn 155 | -------------------------------------------------------------------------------- /src/Codec/JVM/Opcode.hs: -------------------------------------------------------------------------------- 1 | module Codec.JVM.Opcode where 2 | 3 | import Data.Word (Word8) 4 | 5 | newtype Opcode = Opcode Int 6 | 7 | opcode :: Opcode -> Word8 8 | opcode (Opcode i) = fromIntegral i 9 | 10 | -- | https://docs.oracle.com/javase/specs/jvms/se8/html/jvms-6.html 11 | 12 | nop :: Opcode 13 | aconst_null :: Opcode 14 | iconst_m1 :: Opcode 15 | iconst_0 :: Opcode 16 | iconst_1 :: Opcode 17 | iconst_2 :: Opcode 18 | iconst_3 :: Opcode 19 | iconst_4 :: Opcode 20 | iconst_5 :: Opcode 21 | lconst_0 :: Opcode 22 | lconst_1 :: Opcode 23 | fconst_0 :: Opcode 24 | fconst_1 :: Opcode 25 | fconst_2 :: Opcode 26 | dconst_0 :: Opcode 27 | dconst_1 :: Opcode 28 | bipush :: Opcode 29 | sipush :: Opcode 30 | ldc :: Opcode 31 | ldc_w :: Opcode 32 | ldc2_w :: Opcode 33 | iload :: Opcode 34 | lload :: Opcode 35 | fload :: Opcode 36 | dload :: Opcode 37 | aload :: Opcode 38 | iload_0 :: Opcode 39 | iload_1 :: Opcode 40 | iload_2 :: Opcode 41 | iload_3 :: Opcode 42 | lload_0 :: Opcode 43 | lload_1 :: Opcode 44 | lload_2 :: Opcode 45 | lload_3 :: Opcode 46 | fload_0 :: Opcode 47 | fload_1 :: Opcode 48 | fload_2 :: Opcode 49 | fload_3 :: Opcode 50 | dload_0 :: Opcode 51 | dload_1 :: Opcode 52 | dload_2 :: Opcode 53 | dload_3 :: Opcode 54 | aload_0 :: Opcode 55 | aload_1 :: Opcode 56 | aload_2 :: Opcode 57 | aload_3 :: Opcode 58 | iaload :: Opcode 59 | laload :: Opcode 60 | faload :: Opcode 61 | daload :: Opcode 62 | aaload :: Opcode 63 | baload :: Opcode 64 | caload :: Opcode 65 | saload :: Opcode 66 | istore :: Opcode 67 | lstore :: Opcode 68 | fstore :: Opcode 69 | dstore :: Opcode 70 | astore :: Opcode 71 | istore_0 :: Opcode 72 | istore_1 :: Opcode 73 | istore_2 :: Opcode 74 | istore_3 :: Opcode 75 | lstore_0 :: Opcode 76 | lstore_1 :: Opcode 77 | lstore_2 :: Opcode 78 | lstore_3 :: Opcode 79 | fstore_0 :: Opcode 80 | fstore_1 :: Opcode 81 | fstore_2 :: Opcode 82 | fstore_3 :: Opcode 83 | dstore_0 :: Opcode 84 | dstore_1 :: Opcode 85 | dstore_2 :: Opcode 86 | dstore_3 :: Opcode 87 | astore_0 :: Opcode 88 | astore_1 :: Opcode 89 | astore_2 :: Opcode 90 | astore_3 :: Opcode 91 | iastore :: Opcode 92 | lastore :: Opcode 93 | fastore :: Opcode 94 | dastore :: Opcode 95 | aastore :: Opcode 96 | bastore :: Opcode 97 | castore :: Opcode 98 | sastore :: Opcode 99 | pop :: Opcode 100 | pop2 :: Opcode 101 | dup :: Opcode 102 | dup_x1 :: Opcode 103 | dup_x2 :: Opcode 104 | dup2 :: Opcode 105 | dup2_x1 :: Opcode 106 | dup2_x2 :: Opcode 107 | swap :: Opcode 108 | iadd :: Opcode 109 | ladd :: Opcode 110 | fadd :: Opcode 111 | dadd :: Opcode 112 | isub :: Opcode 113 | lsub :: Opcode 114 | fsub :: Opcode 115 | dsub :: Opcode 116 | imul :: Opcode 117 | lmul :: Opcode 118 | fmul :: Opcode 119 | dmul :: Opcode 120 | idiv :: Opcode 121 | ldiv :: Opcode 122 | fdiv :: Opcode 123 | ddiv :: Opcode 124 | irem :: Opcode 125 | lrem :: Opcode 126 | frem :: Opcode 127 | drem :: Opcode 128 | ineg :: Opcode 129 | lneg :: Opcode 130 | fneg :: Opcode 131 | dneg :: Opcode 132 | ishl :: Opcode 133 | lshl :: Opcode 134 | ishr :: Opcode 135 | lshr :: Opcode 136 | iushr :: Opcode 137 | lushr :: Opcode 138 | iand :: Opcode 139 | land :: Opcode 140 | ior :: Opcode 141 | lor :: Opcode 142 | ixor :: Opcode 143 | lxor :: Opcode 144 | iinc :: Opcode 145 | i2l :: Opcode 146 | i2f :: Opcode 147 | i2d :: Opcode 148 | l2i :: Opcode 149 | l2f :: Opcode 150 | l2d :: Opcode 151 | f2i :: Opcode 152 | f2l :: Opcode 153 | f2d :: Opcode 154 | d2i :: Opcode 155 | d2l :: Opcode 156 | d2f :: Opcode 157 | i2b :: Opcode 158 | i2c :: Opcode 159 | i2s :: Opcode 160 | lcmp :: Opcode 161 | fcmpl :: Opcode 162 | fcmpg :: Opcode 163 | dcmpl :: Opcode 164 | dcmpg :: Opcode 165 | ifeq :: Opcode 166 | ifne :: Opcode 167 | iflt :: Opcode 168 | ifge :: Opcode 169 | ifgt :: Opcode 170 | ifle :: Opcode 171 | if_icmpeq :: Opcode 172 | if_icmpne :: Opcode 173 | if_icmplt :: Opcode 174 | if_icmpge :: Opcode 175 | if_icmpgt :: Opcode 176 | if_icmple :: Opcode 177 | if_acmpeq :: Opcode 178 | if_acmpne :: Opcode 179 | goto :: Opcode 180 | jsr :: Opcode 181 | ret :: Opcode 182 | tableswitch :: Opcode 183 | lookupswitch :: Opcode 184 | ireturn :: Opcode 185 | lreturn :: Opcode 186 | freturn :: Opcode 187 | dreturn :: Opcode 188 | areturn :: Opcode 189 | vreturn :: Opcode -- return 190 | getstatic :: Opcode 191 | putstatic :: Opcode 192 | getfield :: Opcode 193 | putfield :: Opcode 194 | invokevirtual :: Opcode 195 | invokespecial :: Opcode 196 | invokestatic :: Opcode 197 | invokeinterface :: Opcode 198 | invokedynamic :: Opcode 199 | new :: Opcode 200 | newarray :: Opcode 201 | anewarray :: Opcode 202 | arraylength :: Opcode 203 | athrow :: Opcode 204 | checkcast :: Opcode 205 | instanceof :: Opcode 206 | monitorenter :: Opcode 207 | monitorexit :: Opcode 208 | wide :: Opcode 209 | multianewarray :: Opcode 210 | ifnull :: Opcode 211 | ifnonnull :: Opcode 212 | goto_w :: Opcode 213 | jsr_w :: Opcode 214 | 215 | nop = Opcode 0x00 216 | aconst_null = Opcode 0x01 217 | iconst_m1 = Opcode 0x02 218 | iconst_0 = Opcode 0x03 219 | iconst_1 = Opcode 0x04 220 | iconst_2 = Opcode 0x05 221 | iconst_3 = Opcode 0x06 222 | iconst_4 = Opcode 0x07 223 | iconst_5 = Opcode 0x08 224 | lconst_0 = Opcode 0x09 225 | lconst_1 = Opcode 0x0a 226 | fconst_0 = Opcode 0x0b 227 | fconst_1 = Opcode 0x0c 228 | fconst_2 = Opcode 0x0d 229 | dconst_0 = Opcode 0x0e 230 | dconst_1 = Opcode 0x0f 231 | bipush = Opcode 0x10 232 | sipush = Opcode 0x11 233 | ldc = Opcode 0x12 234 | ldc_w = Opcode 0x13 235 | ldc2_w = Opcode 0x14 236 | iload = Opcode 0x15 237 | lload = Opcode 0x16 238 | fload = Opcode 0x17 239 | dload = Opcode 0x18 240 | aload = Opcode 0x19 241 | iload_0 = Opcode 0x1a 242 | iload_1 = Opcode 0x1b 243 | iload_2 = Opcode 0x1c 244 | iload_3 = Opcode 0x1d 245 | lload_0 = Opcode 0x1e 246 | lload_1 = Opcode 0x1f 247 | lload_2 = Opcode 0x20 248 | lload_3 = Opcode 0x21 249 | fload_0 = Opcode 0x22 250 | fload_1 = Opcode 0x23 251 | fload_2 = Opcode 0x24 252 | fload_3 = Opcode 0x25 253 | dload_0 = Opcode 0x26 254 | dload_1 = Opcode 0x27 255 | dload_2 = Opcode 0x28 256 | dload_3 = Opcode 0x29 257 | aload_0 = Opcode 0x2a 258 | aload_1 = Opcode 0x2b 259 | aload_2 = Opcode 0x2c 260 | aload_3 = Opcode 0x2d 261 | iaload = Opcode 0x2e 262 | laload = Opcode 0x2f 263 | faload = Opcode 0x30 264 | daload = Opcode 0x31 265 | aaload = Opcode 0x32 266 | baload = Opcode 0x33 267 | caload = Opcode 0x34 268 | saload = Opcode 0x35 269 | istore = Opcode 0x36 270 | lstore = Opcode 0x37 271 | fstore = Opcode 0x38 272 | dstore = Opcode 0x39 273 | astore = Opcode 0x3a 274 | istore_0 = Opcode 0x3b 275 | istore_1 = Opcode 0x3c 276 | istore_2 = Opcode 0x3d 277 | istore_3 = Opcode 0x3e 278 | lstore_0 = Opcode 0x3f 279 | lstore_1 = Opcode 0x40 280 | lstore_2 = Opcode 0x41 281 | lstore_3 = Opcode 0x42 282 | fstore_0 = Opcode 0x43 283 | fstore_1 = Opcode 0x44 284 | fstore_2 = Opcode 0x45 285 | fstore_3 = Opcode 0x46 286 | dstore_0 = Opcode 0x47 287 | dstore_1 = Opcode 0x48 288 | dstore_2 = Opcode 0x49 289 | dstore_3 = Opcode 0x4a 290 | astore_0 = Opcode 0x4b 291 | astore_1 = Opcode 0x4c 292 | astore_2 = Opcode 0x4d 293 | astore_3 = Opcode 0x4e 294 | iastore = Opcode 0x4f 295 | lastore = Opcode 0x50 296 | fastore = Opcode 0x51 297 | dastore = Opcode 0x52 298 | aastore = Opcode 0x53 299 | bastore = Opcode 0x54 300 | castore = Opcode 0x55 301 | sastore = Opcode 0x56 302 | pop = Opcode 0x57 303 | pop2 = Opcode 0x58 304 | dup = Opcode 0x59 305 | dup_x1 = Opcode 0x5a 306 | dup_x2 = Opcode 0x5b 307 | dup2 = Opcode 0x5c 308 | dup2_x1 = Opcode 0x5d 309 | dup2_x2 = Opcode 0x5e 310 | swap = Opcode 0x5f 311 | iadd = Opcode 0x60 312 | ladd = Opcode 0x61 313 | fadd = Opcode 0x62 314 | dadd = Opcode 0x63 315 | isub = Opcode 0x64 316 | lsub = Opcode 0x65 317 | fsub = Opcode 0x66 318 | dsub = Opcode 0x67 319 | imul = Opcode 0x68 320 | lmul = Opcode 0x69 321 | fmul = Opcode 0x6a 322 | dmul = Opcode 0x6b 323 | idiv = Opcode 0x6c 324 | ldiv = Opcode 0x6d 325 | fdiv = Opcode 0x6e 326 | ddiv = Opcode 0x6f 327 | irem = Opcode 0x70 328 | lrem = Opcode 0x71 329 | frem = Opcode 0x72 330 | drem = Opcode 0x73 331 | ineg = Opcode 0x74 332 | lneg = Opcode 0x75 333 | fneg = Opcode 0x76 334 | dneg = Opcode 0x77 335 | ishl = Opcode 0x78 336 | lshl = Opcode 0x79 337 | ishr = Opcode 0x7a 338 | lshr = Opcode 0x7b 339 | iushr = Opcode 0x7c 340 | lushr = Opcode 0x7d 341 | iand = Opcode 0x7e 342 | land = Opcode 0x7f 343 | ior = Opcode 0x80 344 | lor = Opcode 0x81 345 | ixor = Opcode 0x82 346 | lxor = Opcode 0x83 347 | iinc = Opcode 0x84 348 | i2l = Opcode 0x85 349 | i2f = Opcode 0x86 350 | i2d = Opcode 0x87 351 | l2i = Opcode 0x88 352 | l2f = Opcode 0x89 353 | l2d = Opcode 0x8a 354 | f2i = Opcode 0x8b 355 | f2l = Opcode 0x8c 356 | f2d = Opcode 0x8d 357 | d2i = Opcode 0x8e 358 | d2l = Opcode 0x8f 359 | d2f = Opcode 0x90 360 | i2b = Opcode 0x91 361 | i2c = Opcode 0x92 362 | i2s = Opcode 0x93 363 | lcmp = Opcode 0x94 364 | fcmpl = Opcode 0x95 365 | fcmpg = Opcode 0x96 366 | dcmpl = Opcode 0x97 367 | dcmpg = Opcode 0x98 368 | ifeq = Opcode 0x99 369 | ifne = Opcode 0x9a 370 | iflt = Opcode 0x9b 371 | ifge = Opcode 0x9c 372 | ifgt = Opcode 0x9d 373 | ifle = Opcode 0x9e 374 | if_icmpeq = Opcode 0x9f 375 | if_icmpne = Opcode 0xa0 376 | if_icmplt = Opcode 0xa1 377 | if_icmpge = Opcode 0xa2 378 | if_icmpgt = Opcode 0xa3 379 | if_icmple = Opcode 0xa4 380 | if_acmpeq = Opcode 0xa5 381 | if_acmpne = Opcode 0xa6 382 | goto = Opcode 0xa7 383 | jsr = Opcode 0xa8 384 | ret = Opcode 0xa9 385 | tableswitch = Opcode 0xaa 386 | lookupswitch = Opcode 0xab 387 | ireturn = Opcode 0xac 388 | lreturn = Opcode 0xad 389 | freturn = Opcode 0xae 390 | dreturn = Opcode 0xaf 391 | areturn = Opcode 0xb0 392 | vreturn = Opcode 0xb1 -- return 393 | getstatic = Opcode 0xb2 394 | putstatic = Opcode 0xb3 395 | getfield = Opcode 0xb4 396 | putfield = Opcode 0xb5 397 | invokevirtual = Opcode 0xb6 398 | invokespecial = Opcode 0xb7 399 | invokestatic = Opcode 0xb8 400 | invokeinterface = Opcode 0xb9 401 | invokedynamic = Opcode 0xba 402 | new = Opcode 0xbb 403 | newarray = Opcode 0xbc 404 | anewarray = Opcode 0xbd 405 | arraylength = Opcode 0xbe 406 | athrow = Opcode 0xbf 407 | checkcast = Opcode 0xc0 408 | instanceof = Opcode 0xc1 409 | monitorenter = Opcode 0xc2 410 | monitorexit = Opcode 0xc3 411 | wide = Opcode 0xc4 412 | multianewarray = Opcode 0xc5 413 | ifnull = Opcode 0xc6 414 | ifnonnull = Opcode 0xc7 415 | goto_w = Opcode 0xc8 416 | jsr_w = Opcode 0xc9 417 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | 2 | Apache License 3 | Version 2.0, January 2004 4 | http://www.apache.org/licenses/ 5 | 6 | TERMS AND CONDITIONS FOR USE, REPRODUCTION, AND DISTRIBUTION 7 | 8 | 1. Definitions. 9 | 10 | "License" shall mean the terms and conditions for use, reproduction, 11 | and distribution as defined by Sections 1 through 9 of this document. 12 | 13 | "Licensor" shall mean the copyright owner or entity authorized by 14 | the copyright owner that is granting the License. 15 | 16 | "Legal Entity" shall mean the union of the acting entity and all 17 | other entities that control, are controlled by, or are under common 18 | control with that entity. For the purposes of this definition, 19 | "control" means (i) the power, direct or indirect, to cause the 20 | direction or management of such entity, whether by contract or 21 | otherwise, or (ii) ownership of fifty percent (50%) or more of the 22 | outstanding shares, or (iii) beneficial ownership of such entity. 23 | 24 | "You" (or "Your") shall mean an individual or Legal Entity 25 | exercising permissions granted by this License. 26 | 27 | "Source" form shall mean the preferred form for making modifications, 28 | including but not limited to software source code, documentation 29 | source, and configuration files. 30 | 31 | "Object" form shall mean any form resulting from mechanical 32 | transformation or translation of a Source form, including but 33 | not limited to compiled object code, generated documentation, 34 | and conversions to other media types. 35 | 36 | "Work" shall mean the work of authorship, whether in Source or 37 | Object form, made available under the License, as indicated by a 38 | copyright notice that is included in or attached to the work 39 | (an example is provided in the Appendix below). 40 | 41 | "Derivative Works" shall mean any work, whether in Source or Object 42 | form, that is based on (or derived from) the Work and for which the 43 | editorial revisions, annotations, elaborations, or other modifications 44 | represent, as a whole, an original work of authorship. For the purposes 45 | of this License, Derivative Works shall not include works that remain 46 | separable from, or merely link (or bind by name) to the interfaces of, 47 | the Work and Derivative Works thereof. 48 | 49 | "Contribution" shall mean any work of authorship, including 50 | the original version of the Work and any modifications or additions 51 | to that Work or Derivative Works thereof, that is intentionally 52 | submitted to Licensor for inclusion in the Work by the copyright owner 53 | or by an individual or Legal Entity authorized to submit on behalf of 54 | the copyright owner. For the purposes of this definition, "submitted" 55 | means any form of electronic, verbal, or written communication sent 56 | to the Licensor or its representatives, including but not limited to 57 | communication on electronic mailing lists, source code control systems, 58 | and issue tracking systems that are managed by, or on behalf of, the 59 | Licensor for the purpose of discussing and improving the Work, but 60 | excluding communication that is conspicuously marked or otherwise 61 | designated in writing by the copyright owner as "Not a Contribution." 62 | 63 | "Contributor" shall mean Licensor and any individual or Legal Entity 64 | on behalf of whom a Contribution has been received by Licensor and 65 | subsequently incorporated within the Work. 66 | 67 | 2. Grant of Copyright License. Subject to the terms and conditions of 68 | this License, each Contributor hereby grants to You a perpetual, 69 | worldwide, non-exclusive, no-charge, royalty-free, irrevocable 70 | copyright license to reproduce, prepare Derivative Works of, 71 | publicly display, publicly perform, sublicense, and distribute the 72 | Work and such Derivative Works in Source or Object form. 73 | 74 | 3. Grant of Patent License. Subject to the terms and conditions of 75 | this License, each Contributor hereby grants to You a perpetual, 76 | worldwide, non-exclusive, no-charge, royalty-free, irrevocable 77 | (except as stated in this section) patent license to make, have made, 78 | use, offer to sell, sell, import, and otherwise transfer the Work, 79 | where such license applies only to those patent claims licensable 80 | by such Contributor that are necessarily infringed by their 81 | Contribution(s) alone or by combination of their Contribution(s) 82 | with the Work to which such Contribution(s) was submitted. If You 83 | institute patent litigation against any entity (including a 84 | cross-claim or counterclaim in a lawsuit) alleging that the Work 85 | or a Contribution incorporated within the Work constitutes direct 86 | or contributory patent infringement, then any patent licenses 87 | granted to You under this License for that Work shall terminate 88 | as of the date such litigation is filed. 89 | 90 | 4. Redistribution. You may reproduce and distribute copies of the 91 | Work or Derivative Works thereof in any medium, with or without 92 | modifications, and in Source or Object form, provided that You 93 | meet the following conditions: 94 | 95 | (a) You must give any other recipients of the Work or 96 | Derivative Works a copy of this License; and 97 | 98 | (b) You must cause any modified files to carry prominent notices 99 | stating that You changed the files; and 100 | 101 | (c) You must retain, in the Source form of any Derivative Works 102 | that You distribute, all copyright, patent, trademark, and 103 | attribution notices from the Source form of the Work, 104 | excluding those notices that do not pertain to any part of 105 | the Derivative Works; and 106 | 107 | (d) If the Work includes a "NOTICE" text file as part of its 108 | distribution, then any Derivative Works that You distribute must 109 | include a readable copy of the attribution notices contained 110 | within such NOTICE file, excluding those notices that do not 111 | pertain to any part of the Derivative Works, in at least one 112 | of the following places: within a NOTICE text file distributed 113 | as part of the Derivative Works; within the Source form or 114 | documentation, if provided along with the Derivative Works; or, 115 | within a display generated by the Derivative Works, if and 116 | wherever such third-party notices normally appear. The contents 117 | of the NOTICE file are for informational purposes only and 118 | do not modify the License. You may add Your own attribution 119 | notices within Derivative Works that You distribute, alongside 120 | or as an addendum to the NOTICE text from the Work, provided 121 | that such additional attribution notices cannot be construed 122 | as modifying the License. 123 | 124 | You may add Your own copyright statement to Your modifications and 125 | may provide additional or different license terms and conditions 126 | for use, reproduction, or distribution of Your modifications, or 127 | for any such Derivative Works as a whole, provided Your use, 128 | reproduction, and distribution of the Work otherwise complies with 129 | the conditions stated in this License. 130 | 131 | 5. Submission of Contributions. Unless You explicitly state otherwise, 132 | any Contribution intentionally submitted for inclusion in the Work 133 | by You to the Licensor shall be under the terms and conditions of 134 | this License, without any additional terms or conditions. 135 | Notwithstanding the above, nothing herein shall supersede or modify 136 | the terms of any separate license agreement you may have executed 137 | with Licensor regarding such Contributions. 138 | 139 | 6. Trademarks. This License does not grant permission to use the trade 140 | names, trademarks, service marks, or product names of the Licensor, 141 | except as required for reasonable and customary use in describing the 142 | origin of the Work and reproducing the content of the NOTICE file. 143 | 144 | 7. Disclaimer of Warranty. Unless required by applicable law or 145 | agreed to in writing, Licensor provides the Work (and each 146 | Contributor provides its Contributions) on an "AS IS" BASIS, 147 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or 148 | implied, including, without limitation, any warranties or conditions 149 | of TITLE, NON-INFRINGEMENT, MERCHANTABILITY, or FITNESS FOR A 150 | PARTICULAR PURPOSE. You are solely responsible for determining the 151 | appropriateness of using or redistributing the Work and assume any 152 | risks associated with Your exercise of permissions under this License. 153 | 154 | 8. Limitation of Liability. In no event and under no legal theory, 155 | whether in tort (including negligence), contract, or otherwise, 156 | unless required by applicable law (such as deliberate and grossly 157 | negligent acts) or agreed to in writing, shall any Contributor be 158 | liable to You for damages, including any direct, indirect, special, 159 | incidental, or consequential damages of any character arising as a 160 | result of this License or out of the use or inability to use the 161 | Work (including but not limited to damages for loss of goodwill, 162 | work stoppage, computer failure or malfunction, or any and all 163 | other commercial damages or losses), even if such Contributor 164 | has been advised of the possibility of such damages. 165 | 166 | 9. Accepting Warranty or Additional Liability. While redistributing 167 | the Work or Derivative Works thereof, You may choose to offer, 168 | and charge a fee for, acceptance of support, warranty, indemnity, 169 | or other liability obligations and/or rights consistent with this 170 | License. However, in accepting such obligations, You may act only 171 | on Your own behalf and on Your sole responsibility, not on behalf 172 | of any other Contributor, and only if You agree to indemnify, 173 | defend, and hold each Contributor harmless for any liability 174 | incurred by, or claims asserted against, such Contributor by reason 175 | of your accepting any such warranty or additional liability. 176 | 177 | END OF TERMS AND CONDITIONS 178 | 179 | APPENDIX: How to apply the Apache License to your work. 180 | 181 | To apply the Apache License to your work, attach the following 182 | boilerplate notice, with the fields enclosed by brackets "[]" 183 | replaced with your own identifying information. (Don't include 184 | the brackets!) The text should be enclosed in the appropriate 185 | comment syntax for the file format. We also recommend that a 186 | file or class name and description of purpose be included on the 187 | same "printed page" as the copyright notice for easier 188 | identification within third-party archives. 189 | 190 | Copyright [yyyy] [name of copyright owner] 191 | 192 | Licensed under the Apache License, Version 2.0 (the "License"); 193 | you may not use this file except in compliance with the License. 194 | You may obtain a copy of the License at 195 | 196 | http://www.apache.org/licenses/LICENSE-2.0 197 | 198 | Unless required by applicable law or agreed to in writing, software 199 | distributed under the License is distributed on an "AS IS" BASIS, 200 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 201 | See the License for the specific language governing permissions and 202 | limitations under the License. 203 | --------------------------------------------------------------------------------