import JVM.Common () -- import instances only
import JVM.ClassFile
import JVM.Assembler
+import Java.ClassPath
-- | Generator state
data GState = GState {
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
+ currentPool :: Pool Direct, -- ^ Already generated constants pool
+ doneMethods :: [Method Direct], -- ^ Already generated class methods
+ currentMethod :: Maybe (Method Direct), -- ^ Current method
stackSize :: Word16, -- ^ Maximum stack size for current method
- locals :: Word16 -- ^ Maximum number of local variables for current method
+ locals :: Word16, -- ^ Maximum number of local variables for current method
+ classPath :: [Tree CPEntry]
}
deriving (Eq,Show)
doneMethods = [],
currentMethod = Nothing,
stackSize = 496,
- locals = 0 }
+ locals = 0,
+ classPath = []}
-- | Generate monad
-type Generate a = State GState a
+type Generate a = StateT GState IO a
+
+withClassPath :: ClassPath () -> Generate ()
+withClassPath cp = do
+ res <- liftIO $ execClassPath cp
+ st <- St.get
+ St.put $ st {classPath = res}
-- | Append a constant to pool
-appendPool :: Constant Resolved -> Pool Resolved -> (Pool Resolved, Word16)
+appendPool :: Constant Direct -> Pool Direct -> (Pool Direct, 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 :: Constant Direct -> Generate Word16
addItem c = do
pool <- St.gets currentPool
case lookupPool c pool of
return (i+1)
-- | Lookup in a pool
-lookupPool :: Constant Resolved -> Pool Resolved -> Maybe Word16
+lookupPool :: Constant Direct -> Pool Direct -> Maybe Word16
lookupPool c pool =
fromIntegral `fmap` findIndex (== c) (M.elems pool)
-addNT :: Binary (Signature a) => NameType a -> Generate Word16
+addNT :: HasSignature a => NameType a -> Generate Word16
addNT (NameType name sig) = do
let bsig = encode sig
x <- addItem (CNameType name bsig)
addItem (CUTF8 bsig)
-- | Add a constant into pool
-addToPool :: Constant Resolved -> Generate Word16
+addToPool :: Constant Direct -> Generate Word16
addToPool c@(CClass str) = do
addItem (CUTF8 str)
addItem c
i0 = putInstruction
-- | Generate one one-argument instruction
-i1 :: (Word16 -> Instruction) -> Constant Resolved -> Generate ()
+i1 :: (Word16 -> Instruction) -> Constant Direct -> Generate ()
i1 fn c = do
ix <- addToPool c
i0 (fn ix)
-- | Generate one one-argument instruction
-i8 :: (Word8 -> Instruction) -> Constant Resolved -> Generate ()
+i8 :: (Word8 -> Instruction) -> Constant Direct -> Generate ()
i8 fn c = do
ix <- addToPool c
i0 (fn $ fromIntegral ix)
addToPool (CString "Code")
-- | Generate a class
-generate :: B.ByteString -> Generate () -> Class Resolved
-generate name gen =
+generate :: [Tree CPEntry] -> B.ByteString -> Generate () -> IO (Class Direct)
+generate cp name gen = do
let generator = do
initClass name
+ st <- St.get
+ St.put $ st {classPath = cp}
gen
- res = execState generator emptyGState
- code = genCode res
- in Class {
- magic = 0xCAFEBABE,
- minorVersion = 0,
- majorVersion = 50,
+ res <- execStateT generator emptyGState
+ let code = genCode res
+ d = defaultClass :: Class Direct
+ return $ d {
constsPoolSize = fromIntegral $ M.size (currentPool res),
constsPool = currentPool res,
accessFlags = S.fromList [ACC_PUBLIC, ACC_STATIC],
thisClass = name,
superClass = "java/lang/Object",
- interfacesCount = 0,
- interfaces = [],
- classFieldsCount = 0,
- classFields = [],
classMethodsCount = fromIntegral $ length (doneMethods res),
- classMethods = doneMethods res,
- classAttributesCount = 0,
- classAttributes = AR M.empty }
+ classMethods = doneMethods res }