Static field support now implemented

Author: LouisJenkinsCS

.gitignore

@@ -4,6 +4,8 @@ Documentation/
 *.dyn_hi*
 *.dyn_o*
 *.log
+*.h
+*.hi-boot
 *.json
 *.exe
 Main

LLVM-JVM.cabal

@@ -20,6 +20,6 @@ executable LLVM-JVM
   main-is:             Main.hs
   -- other-modules:
   other-extensions:    OverloadedStrings, FlexibleContexts, GADTs, ForeignFunctionInterface, MultiParamTypeClasses, FunctionalDependencies, ScopedTypeVariables, TemplateHaskell, CPP, GeneralizedNewtypeDeriving
-  build-depends:       base >=4.8 && <4.9, hs-java >=0.3 && <0.4, split >=0.2 && <0.3, bytestring >=0.10 && <0.11, hs-boehmgc >=0.1 && <0.2, binary >=0.7 && <0.8, containers >=0.5 && <0.6, MissingH >=1.4 && <1.5, directory >=1.2 && <1.3, plugins >=1.5 && <1.6, mtl >=2.2 && <2.3, QuickCheck >=2.8 && <2.9, IntervalMap >=0.5 && <0.6, harpy >=0.6 && <0.7, vector >=0.11 && <0.12, lens >=4.15 && <4.16, llvm-hs-pure >=5.0 && <5.1, llvm-hs -any, extra -any
+  build-depends:       base -any, hs-java >=0.3 && <0.4, split -any, bytestring -any, hs-boehmgc -any, binary -any, containers -any, MissingH -any, directory -any, plugins -any, mtl -any, QuickCheck -any, IntervalMap -any, harpy -any, vector -any, lens -any, llvm-hs-pure -any, llvm-hs -any, extra -any
   -- hs-source-dirs:
   default-language:    Haskell2010

LLVMFrontend/MkGraph.hs

@@ -23,6 +23,7 @@ module LLVMFrontend.MkGraph
   import Data.Int
   import Data.Word
   import Data.Maybe
+  import Unsafe.Coerce
 
   import Control.Applicative hiding ((<*>))
   import Control.Monad
@@ -264,6 +265,7 @@ module LLVMFrontend.MkGraph
     forM_ (S.toList hs ++ [0]) addLabel
     return ()
 
+
   mkBlocks :: ParseState ()
   mkBlocks = do
     pc <- pcOffset <$> get
@@ -619,14 +621,33 @@ module LLVMFrontend.MkGraph
     -- apush nv
     -- return [IRLoad (RTPool x) obj nv]
   tir (GETSTATIC x) = do
-    error "Not Supported"
-    -- cls <- classf <$> get
-    -- nv <- newvar (fieldType cls x)
-    -- apush nv
-    -- return [IRLoad (RTPool x) LT.ptrNull nv]
+    cls <- gets classf
+    (fname, ftype) <- case constsPool cls M.! x of
+      (CField _ (NameType fname ftype)) -> return (fname, ftype)
+      _ -> error $ "Bad index: " ++ show x
+
+    let fieldRef = cons $ global (LT.ptr . jvm2llvmType $ ftype) (mkName' fname)
+    tmp <- newvar
+    pushOperand $ LO.LocalReference (jvm2llvmType ftype) tmp
+    appendInstruction $ tmp LI.:= load fieldRef
+      where
+        mkName' :: B.ByteString -> LN.Name
+        mkName' = LN.mkName . map unsafeCoerce . B.unpack
   tir (PUTSTATIC x) = do
-    error "Not Supported"
-    -- y <- apop
+    y <- popOperand
+
+    cls <- gets classf
+    (fname, ftype) <- case constsPool cls M.! x of
+      (CField _ (NameType fname ftype)) -> return (fname, ftype)
+      _ -> error $ "Bad index: " ++ show x
+
+    let fieldRef = cons $ global (LT.ptr . jvm2llvmType $ ftype) (mkName' fname)
+    appendInstruction $ LI.Do $ store fieldRef y
+      where
+        mkName' :: B.ByteString -> LN.Name
+        mkName' = LN.mkName . map unsafeCoerce . B.unpack
+
+    -- appendInstruction $ LI.Do $ load (global LT.i32 ) 
     -- return [IRStore (RTPool x) LT.ptrNull y]
   tir (LDC1 x) = tir (LDC2 (fromIntegral x))
   tir (LDC2 x) = do

MateVMRuntime/MethodPool.hs

@@ -14,6 +14,7 @@ import Data.Maybe (fromJust)
 
 import Foreign
 import Foreign.C.Types
+import Unsafe.Coerce
 
 import JVM.ClassFile
 import JVM.Assembler
@@ -27,7 +28,10 @@ import MateVMRuntime.ClassPool
 import MateVMRuntime.NativeMethods
 
 import qualified LLVM.AST as AST
+import qualified LLVM.AST.Global as LG
+import qualified LLVM.AST.Linkage as LL
 import qualified LLVM.ExecutionEngine as EE
+import qualified LLVM.AST.Constant as LC
 import LLVM.Context
 import LLVM.CodeModel
 import LLVM.Target
@@ -96,6 +100,20 @@ insertCompiledMethod entry (MethodInfo mmname _ msig) clsnames = do
 initModule :: AST.Module
 initModule = AST.defaultModule { AST.moduleName = "dummy" }
 
+mkName' :: B.ByteString -> AST.Name
+mkName' = AST.mkName . map unsafeCoerce . B.unpack
+
+parseFields :: Class Direct -> [AST.Definition]
+parseFields cls = 
+  flip map (classFields cls) $ \field -> 
+    let nameType = fieldNameType field in
+      AST.GlobalDefinition $ LG.globalVariableDefaults { 
+        LG.name = mkName' $ ntName nameType,
+        LG.type' = jvm2llvmType $ ntSignature nameType,
+        LG.linkage = LL.Private,
+        LG.initializer = Just $ LC.Int 32 0
+      }
+
 -- Stubbed for now...
 -- TODO: Do LLVM
 compileMethod :: B.ByteString -> MethodSignature -> Class Direct -> IO (a,b)
@@ -105,7 +123,7 @@ compileMethod name sig cls = do
 
   cfg <- pipeline cls meth (codeInstructions . decodeMethod $ code)
   -- cfg <- parseCFG (decodeMethod code)
-  let mod = AST.defaultModule { AST.moduleDefinitions = [defineFn (returnType sig) "main" (M.elems $ basicBlocks cfg)], AST.moduleName = "Dummy" }
+  let mod = AST.defaultModule { AST.moduleDefinitions = parseFields cls ++ [defineFn (returnType sig) "main" (M.elems $ basicBlocks cfg)], AST.moduleName = "Dummy" }
   ast <- compileMethod' mod
   error . show $ ast
 
@@ -135,7 +153,8 @@ compileMethod' mod =
             case mainfn of
               Just fn -> do
                 result <- code_int (castFunPtr fn :: FunPtr (IO Int))
-                printfJit $ "Evaluated to: " ++ show result
+                printfJit . show $ result
+                
               Nothing -> return ()
 
           -- Optimized module used only in next pass...

Test.bash

@@ -29,7 +29,8 @@ for d in */; do
       continue
     fi
 
-    bootstrap=$(locate -r '/rt.jar$')
+    bootstrap=$(java -verbose 2>/dev/null | sed -ne '1 s/\[Opened \(.*\)\]/\1/p')
+    echo "bootstrap: $bootstrap, file: $f"
     javac -target 1.7 -source 1.7 -bootclasspath $bootstrap $f
     ../../Main.exe -cp ../../rt:./ "$filename" 1> tmp.out 2> tmp.err
 

Unit/Basic/Addition.java

@@ -1,12 +1,13 @@
 class Addition {
 
+  public static int result;
+
   public static int RunMe() {
     int x = 0x1000;
     int y = 0x2000;
     int z = 0x3000;
     int w = x + y + z;
 
-    int result;
     if (w > x) {
       result = w;
     } else if (y > w) {

example.hs

@@ -0,0 +1,4 @@
+main :: IO ()
+main = putStrLn "Hello World"
+	a 1 2a
+	prelude