next <- readInstructions
return (x: next)
--- | JVM instruction set
+-- | JVM instruction set. For comments, see JVM specification.
data Instruction =
NOP -- ^ 0
| ACONST_NULL -- ^ 1
| inRange (159, 164) c -> IF_ICMP (toEnum $ fromIntegral $ c-159) <$> get
| otherwise -> fail $ "Unknown instruction byte code: " ++ show c
+-- | Encode list of instructions
encodeInstructions :: [Instruction] -> B.ByteString
encodeInstructions code =
let p list = forM_ list put
-
+-- | This module exports shortcuts for some of JVM instructions (which are defined in JVM.Assembler).
module JVM.Builder.Instructions where
+import Data.Word
+import qualified Data.ByteString.Lazy as B
+
import JVM.ClassFile
import JVM.Assembler
import JVM.Builder.Monad
+nop :: Generate ()
nop = i0 NOP
+aconst_null :: Generate ()
aconst_null = i0 ACONST_NULL
+iconst_m1 :: Generate ()
iconst_m1 = i0 ICONST_M1
+iconst_0 :: Generate ()
iconst_0 = i0 ICONST_0
+iconst_1 :: Generate ()
iconst_1 = i0 ICONST_1
+iconst_2 :: Generate ()
iconst_2 = i0 ICONST_2
+iconst_3 :: Generate ()
iconst_3 = i0 ICONST_3
+iconst_4 :: Generate ()
iconst_4 = i0 ICONST_4
+iconst_5 :: Generate ()
iconst_5 = i0 ICONST_5
+lconst_0 :: Generate ()
lconst_0 = i0 LCONST_0
+lconst_1 :: Generate ()
lconst_1 = i0 LCONST_1
+fconst_0 :: Generate ()
fconst_0 = i0 FCONST_0
+fconst_1 :: Generate ()
fconst_1 = i0 FCONST_1
+fconst_2 :: Generate ()
fconst_2 = i0 FCONST_2
+dconst_0 :: Generate ()
dconst_0 = i0 DCONST_0
+dconst_1 :: Generate ()
dconst_1 = i0 DCONST_1
+bipush :: Word8 -> Generate ()
bipush x = i0 (BIPUSH x)
+sipush :: Word16 -> Generate ()
sipush x = i0 (SIPUSH x)
+ldc1 :: Constant Resolved -> Generate ()
ldc1 x = i8 LDC1 x
+ldc2 :: Constant Resolved -> Generate ()
ldc2 x = i1 LDC2 x
+ldc2w :: Constant Resolved -> Generate ()
ldc2w x = i1 LDC2W x
+iload :: Constant Resolved -> Generate ()
iload x = i8 ILOAD x
+lload :: Constant Resolved -> Generate ()
lload x = i8 LLOAD x
+fload :: Constant Resolved -> Generate ()
fload x = i8 FLOAD x
+dload :: Constant Resolved -> Generate ()
dload x = i8 DLOAD x
+aload :: Constant Resolved -> Generate ()
aload x = i8 ALOAD x
+iload_ :: IMM -> Generate ()
iload_ x = i0 (ILOAD_ x)
+lload_ :: IMM -> Generate ()
lload_ x = i0 (LLOAD_ x)
+fload_ :: IMM -> Generate ()
fload_ x = i0 (FLOAD_ x)
+dload_ :: IMM -> Generate ()
dload_ x = i0 (DLOAD_ x)
+aload_ :: IMM -> Generate ()
aload_ x = i0 (ALOAD_ x)
+iaload :: Generate ()
iaload = i0 IALOAD
+laload :: Generate ()
laload = i0 LALOAD
+faload :: Generate ()
faload = i0 FALOAD
+daload :: Generate ()
daload = i0 DALOAD
+aaload :: Generate ()
aaload = i0 AALOAD
+caload :: Generate ()
caload = i0 CALOAD
+saload :: Generate ()
saload = i0 SALOAD
+istore :: Constant Resolved -> Generate ()
istore x = i8 ISTORE x
+lstore :: Constant Resolved -> Generate ()
lstore x = i8 LSTORE x
+fstore :: Constant Resolved -> Generate ()
fstore x = i8 FSTORE x
+dstore :: Constant Resolved -> Generate ()
dstore x = i8 DSTORE x
+astore :: Constant Resolved -> Generate ()
astore x = i8 ASTORE x
+istore_ :: Word8 -> Generate ()
istore_ x = i0 (ISTORE x)
+lstore_ :: Word8 -> Generate ()
lstore_ x = i0 (LSTORE x)
+fstore_ :: Word8 -> Generate ()
fstore_ x = i0 (FSTORE x)
+dstore_ :: Word8 -> Generate ()
dstore_ x = i0 (DSTORE x)
+astore_ :: Word8 -> Generate ()
astore_ x = i0 (ASTORE x)
+iastore :: Generate ()
iastore = i0 IASTORE
+lastore :: Generate ()
lastore = i0 LASTORE
+fastore :: Generate ()
fastore = i0 FASTORE
+dastore :: Generate ()
dastore = i0 DASTORE
+aastore :: Generate ()
aastore = i0 AASTORE
+bastore :: Generate ()
bastore = i0 BASTORE
+castore :: Generate ()
castore = i0 CASTORE
+sastore :: Generate ()
sastore = i0 SASTORE
+pop :: Generate ()
pop = i0 POP
+pop2 :: Generate ()
pop2 = i0 POP2
+dup :: Generate ()
dup = i0 DUP
+dup_x1 :: Generate ()
dup_x1 = i0 DUP_X1
+dup_x2 :: Generate ()
dup_x2 = i0 DUP_X2
+dup2 :: Generate ()
dup2 = i0 DUP2
+dup2_x1 :: Generate ()
dup2_x1 = i0 DUP2_X1
+dup2_x2 :: Generate ()
dup2_x2 = i0 DUP2_X2
+swap :: Generate ()
swap = i0 SWAP
+iadd :: Generate ()
iadd = i0 IADD
+ladd :: Generate ()
ladd = i0 LADD
+fadd :: Generate ()
fadd = i0 FADD
+dadd :: Generate ()
dadd = i0 DADD
+isub :: Generate ()
isub = i0 ISUB
+lsub :: Generate ()
lsub = i0 LSUB
+fsub :: Generate ()
fsub = i0 FSUB
+dsub :: Generate ()
dsub = i0 DSUB
+imul :: Generate ()
imul = i0 IMUL
+lmul :: Generate ()
lmul = i0 LMUL
+fmul :: Generate ()
fmul = i0 FMUL
+dmul :: Generate ()
dmul = i0 DMUL
+idiv :: Generate ()
idiv = i0 IDIV
+ldiv :: Generate ()
ldiv = i0 LDIV
+fdiv :: Generate ()
fdiv = i0 FDIV
+ddiv :: Generate ()
ddiv = i0 DDIV
+irem :: Generate ()
irem = i0 IREM
+lrem :: Generate ()
lrem = i0 LREM
+frem :: Generate ()
frem = i0 FREM
+drem :: Generate ()
drem = i0 DREM
+ineg :: Generate ()
ineg = i0 INEG
+lneg :: Generate ()
lneg = i0 LNEG
+fneg :: Generate ()
fneg = i0 FNEG
+dneg :: Generate ()
dneg = i0 DNEG
+ishl :: Generate ()
ishl = i0 ISHL
+lshl :: Generate ()
lshl = i0 LSHL
+ishr :: Generate ()
ishr = i0 ISHR
+lshr :: Generate ()
lshr = i0 LSHR
+iushr :: Generate ()
iushr = i0 IUSHR
+lushr :: Generate ()
lushr = i0 LUSHR
+iand :: Generate ()
iand = i0 IAND
+land :: Generate ()
land = i0 LAND
+ior :: Generate ()
ior = i0 IOR
+lor :: Generate ()
lor = i0 LOR
+ixor :: Generate ()
ixor = i0 IXOR
+lxor :: Generate ()
lxor = i0 LXOR
+iinc :: Word8 -> Word8 -> Generate ()
iinc x y = i0 (IINC x y)
+i2l :: Generate ()
i2l = i0 I2L
+i2f :: Generate ()
i2f = i0 I2F
+i2d :: Generate ()
i2d = i0 I2D
+l2i :: Generate ()
l2i = i0 L2I
+l2f :: Generate ()
l2f = i0 L2F
+l2d :: Generate ()
l2d = i0 L2D
+f2i :: Generate ()
f2i = i0 F2I
+f2l :: Generate ()
f2l = i0 F2L
+f2d :: Generate ()
f2d = i0 F2D
+d2i :: Generate ()
d2i = i0 D2I
+d2l :: Generate ()
d2l = i0 D2L
+d2f :: Generate ()
d2f = i0 D2F
+i2b :: Generate ()
i2b = i0 I2B
+i2c :: Generate ()
i2c = i0 I2C
+i2s :: Generate ()
i2s = i0 I2S
+lcmp :: Generate ()
lcmp = i0 LCMP
+new :: B.ByteString -> Generate ()
new cls =
i1 NEW (CClass cls)
+newArray :: ArrayType -> Generate ()
newArray t =
i0 (NEWARRAY $ atype2byte t)
+allocNewArray :: B.ByteString -> Generate ()
allocNewArray cls =
i1 ANEWARRAY (CClass cls)
+invokeVirtual :: B.ByteString -> NameType Method -> Generate ()
invokeVirtual cls sig =
i1 INVOKEVIRTUAL (CMethod cls sig)
+invokeStatic :: B.ByteString -> NameType Method -> Generate ()
invokeStatic cls sig =
i1 INVOKESTATIC (CMethod cls sig)
+invokeSpecial :: B.ByteString -> NameType Method -> Generate ()
invokeSpecial cls sig =
i1 INVOKESPECIAL (CMethod cls sig)
+getStaticField :: B.ByteString -> NameType Field -> Generate ()
getStaticField cls sig =
i1 GETSTATIC (CField cls sig)
+loadString :: B.ByteString -> Generate ()
loadString str =
i8 LDC1 (CString str)
+allocArray :: B.ByteString -> Generate ()
allocArray cls =
i1 ANEWARRAY (CClass cls)
{-# LANGUAGE FlexibleContexts, TypeFamilies, OverloadedStrings #-}
-module JVM.Builder.Monad where
+-- | This module defines Generate monad, which helps generating JVM code and
+-- creating Java class constants pool.
+module JVM.Builder.Monad
+ (GState (..),
+ emptyGState,
+ Generate,
+ addToPool,
+ i0, i1, i8,
+ newMethod,
+ setStackSize, setMaxLocals,
+ generate
+ ) where
import Control.Monad.State as St
import Data.Word
import JVM.ClassFile
import JVM.Assembler
+-- | Generator state
data GState = GState {
- generated :: [Instruction],
- currentPool :: Pool Resolved,
- doneMethods :: [Method Resolved],
- currentMethod :: Maybe (Method Resolved),
- stackSize :: Word16,
- locals :: Word16 }
+ generated :: [Instruction], -- ^ Already generated code (in current method)
+ currentPool :: Pool Resolved, -- ^ Already generated constants pool
+ doneMethods :: [Method Resolved], -- ^ Already generated class methods
+ currentMethod :: Maybe (Method Resolved), -- ^ Current method
+ stackSize :: Word16, -- ^ Maximum stack size for current method
+ locals :: Word16 -- ^ Maximum number of local variables for current method
+ }
deriving (Eq,Show)
+-- | Empty generator state
+emptyGState :: GState
emptyGState = GState {
generated = [],
currentPool = M.empty,
stackSize = 496,
locals = 0 }
+-- | Generate monad
type Generate a = State GState a
+-- | Append a constant to pool
appendPool :: Constant Resolved -> Pool Resolved -> (Pool Resolved, Word16)
appendPool c pool =
let size = fromIntegral (M.size pool)
pool' = M.insert size c pool
in (pool', size)
+-- | Add a constant to pool
addItem :: Constant Resolved -> Generate Word16
addItem c = do
pool <- St.gets currentPool
St.put $ st {currentPool = pool'}
return (i+1)
+-- | Lookup in a pool
lookupPool :: Constant Resolved -> Pool Resolved -> Maybe Word16
lookupPool c pool =
fromIntegral `fmap` findIndex (== c) (M.elems pool)
let bsig = encode c
addItem (CUTF8 bsig)
+-- | Add a constant into pool
addToPool :: Constant Resolved -> Generate Word16
addToPool c@(CClass str) = do
addItem (CUTF8 str)
let code = generated st
St.put $ st {generated = code ++ [instr]}
+-- | Generate one (zero-arguments) instruction
i0 :: Instruction -> Generate ()
i0 = putInstruction
+-- | Generate one one-argument instruction
i1 :: (Word16 -> Instruction) -> Constant Resolved -> Generate ()
i1 fn c = do
ix <- addToPool c
i0 (fn ix)
+-- | Generate one one-argument instruction
i8 :: (Word8 -> Instruction) -> Constant Resolved -> Generate ()
i8 fn c = do
ix <- addToPool c
i0 (fn $ fromIntegral ix)
+-- | Set maximum stack size for current method
setStackSize :: Word16 -> Generate ()
setStackSize n = do
st <- St.get
St.put $ st {stackSize = n}
+-- | Set maximum number of local variables for current method
setMaxLocals :: Word16 -> Generate ()
setMaxLocals n = do
st <- St.get
St.put $ st {locals = n}
+-- | Start generating new method
startMethod :: [AccessFlag] -> B.ByteString -> MethodSignature -> Generate ()
startMethod flags name sig = do
addToPool (CString name)
St.put $ st {generated = [],
currentMethod = Just method }
+-- | End of method generation
endMethod :: Generate ()
endMethod = do
m <- St.gets currentMethod
currentMethod = Nothing,
doneMethods = doneMethods st ++ [method']}
-newMethod :: [AccessFlag] -> B.ByteString -> [ArgumentSignature] -> ReturnSignature -> Generate () -> Generate (NameType Method)
+-- | Generate new method
+newMethod :: [AccessFlag] -- ^ Access flags for method (public, static etc)
+ -> B.ByteString -- ^ Method name
+ -> [ArgumentSignature] -- ^ Signatures of method arguments
+ -> ReturnSignature -- ^ Method return signature
+ -> Generate () -- ^ Generator for method code
+ -> Generate (NameType Method)
newMethod flags name args ret gen = do
let sig = MethodSignature args ret
startMethod flags name sig
endMethod
return (NameType name sig)
+-- | Convert Generator state to method Code.
genCode :: GState -> Code
genCode st = Code {
codeStackSize = stackSize st,
where
len = fromIntegral $ B.length $ encodeInstructions (generated st)
+-- | Start class generation.
initClass :: B.ByteString -> Generate Word16
initClass name = do
addToPool (CClass "java/lang/Object")
addToPool (CClass name)
addToPool (CString "Code")
+-- | Generate a class
generate :: B.ByteString -> Generate () -> Class Resolved
generate name gen =
let generator = do
{-# LANGUAGE TypeFamilies, StandaloneDeriving, FlexibleInstances, FlexibleContexts, UndecidableInstances #-}
--- | This module declares `high-level' data types for Java classes, methods etc.
-module JVM.Common where
+-- | This module declares some commonly used functions and instances.
+module JVM.Common
+ (toCharList,
+ poolSize,
+ (!),
+ showListIx,
+ byteString
+ ) where
import Codec.Binary.UTF8.String hiding (encode, decode)
import Data.Binary
import JVM.Converter
import JVM.Assembler
+-- | Dump a class to console.
dumpClass :: Class Resolved -> IO ()
dumpClass cls = do
putStr "Class: "
{-# LANGUAGE OverloadedStrings #-}
+-- | This module exports definitions for some most used classes and methods from standard Java java.io package.
module Java.IO where
import Data.String
import qualified Java.Lang
+-- | java.io.PrintStream class name
printStream :: IsString s => s
printStream = "java/io/PrintStream"
+-- | java.io.PrintStream class as field type
+printStreamClass :: FieldType
printStreamClass = ObjectType printStream
println :: NameType Method
{-# LANGUAGE OverloadedStrings #-}
+-- | This module exports some definitions from standard Java java.lang package.
module Java.Lang where
import Data.String
import JVM.Common () -- import instances only
import JVM.ClassFile
+objectClass :: FieldType
objectClass = ObjectType object
+
+stringClass :: FieldType
stringClass = ObjectType string
+
+integerClass :: FieldType
integerClass = ObjectType integer
+
+systemClass :: FieldType
systemClass = ObjectType system
object :: IsString s => s
system :: IsString s => s
system = "java/lang/System"
+-- | java.lang.Object.<init>() method
objectInit :: NameType Method
objectInit = NameType "<init>" $ MethodSignature [] ReturnsVoid
+-- | java.lang.Integer.valueOf() method
valueOfInteger :: NameType Method
valueOfInteger = NameType "valueOf" $ MethodSignature [IntType] (Returns Java.Lang.integerClass)
projects / hs-java.git / commitdiff