codegen: factor offset calculation

[mate.git] / Mate / ClassPool.hs

diff --git a/Mate/ClassPool.hs b/Mate/ClassPool.hs
index ccfe1b3afc7b4bad72e817e09479582cfacc0bc3..eb97e211c9f4c54859353e327df7cef654b58570 100644 (file)
--- a/Mate/ClassPool.hs
+++ b/Mate/ClassPool.hs
@@ -2,41 +2,71 @@
 {-# LANGUAGE ForeignFunctionInterface #-}
 module Mate.ClassPool where
 
-import Data.Binary
-import Data.String.Utils
 import qualified Data.Map as M
 import qualified Data.Set as S
 import qualified Data.ByteString.Lazy as B
-import System.Plugins
 
 import Text.Printf
 
 import Foreign.Ptr
 import Foreign.C.Types
-import Foreign.C.String
-import Foreign.StablePtr
 import Foreign.Marshal.Alloc
 
 import JVM.ClassFile
 import JVM.Converter
 
-import Harpy
-import Harpy.X86Disassembler
-
-import Mate.BasicBlocks
 import Mate.Types
-import Mate.Utilities
 
+getClassInfo :: B.ByteString -> IO ClassInfo
+getClassInfo path = do
+  ptr_classmap <- get_classmap
+  class_map <- ptr2classmap ptr_classmap
+  case M.lookup path class_map of
+    Nothing -> loadClass path
+    Just ci -> return ci
 
 getClassFile :: B.ByteString -> IO (Class Resolved)
 getClassFile path = do
+  (ClassInfo _ cfile _ _) <- getClassInfo path
+  return cfile
+
+getFieldBase :: B.ByteString -> IO (CUInt)
+getFieldBase path = do
+  (ClassInfo _ _ fs _) <- getClassInfo path
+  return $ fromIntegral $ ptrToIntPtr fs
+
+getFieldOffset :: B.ByteString -> B.ByteString -> IO (CUInt)
+getFieldOffset path field = do
+  (ClassInfo _ _ _ fieldmap) <- getClassInfo path
+  return $ fromIntegral $ fieldmap M.! field
+
+foreign export ccall getFieldAddr :: CUInt -> Ptr () -> IO CUInt
+getFieldAddr :: CUInt -> Ptr () -> IO CUInt
+getFieldAddr from ptr_trapmap = do
+  trapmap <- ptr2tmap ptr_trapmap
+  let w32_from = fromIntegral from
+  let sfi = trapmap M.! w32_from
+  case sfi of
+    (SFI (StaticFieldInfo cls field)) -> do
+      off <- getFieldOffset cls field
+      base <- getFieldBase cls
+      return $ base + off
+    _ -> error $ "getFieldAddr: no trapInfo. abort"
+
+loadClass :: B.ByteString -> IO ClassInfo
+loadClass path = do
   ptr_classmap <- get_classmap
   class_map <- ptr2classmap ptr_classmap
-  case M.lookup path class_map of
-    Nothing -> do
-      let rpath = toString $ path `B.append` ".class"
-      cfile <- parseClassFile rpath
-      let class_map' = M.insert path (ClassInfo path cfile) class_map
-      classmap2ptr class_map' >>= set_classmap
-      return cfile
-    Just (ClassInfo name cfs) -> return cfs
+  let rpath = toString $ path `B.append` ".class"
+  cfile <- parseClassFile rpath
+  printf "class fieldlength: %d\n" $ classFieldsCount cfile
+  -- TODO(bernhard): correct sizes. int only atm
+  let filteredfields = filter (S.member ACC_STATIC . fieldAccessFlags) (classFields cfile)
+  let fm = zipWith (\x y -> (fieldName y, x)) [0,4..] filteredfields
+  let fieldmap = M.fromList fm
+  fieldbase <- mallocBytes ((fromIntegral $ M.size fieldmap) * 4)
+  putStrLn $ "fieldmap: " ++ (show fieldmap)
+  let new_ci = ClassInfo path cfile fieldbase fieldmap
+  let class_map' = M.insert path new_ci class_map
+  classmap2ptr class_map' >>= set_classmap
+  return new_ci