1 {-# LANGUAGE OverloadedStrings #-}
2 {-# LANGUAGE ForeignFunctionInterface #-}
3 module Mate.MethodPool where
6 import qualified Data.Map as M
7 import qualified Data.ByteString.Lazy as B
12 import Foreign.C.Types
13 import Foreign.StablePtr
19 import Harpy.X86Disassembler
21 import Mate.BasicBlocks
22 import Mate.X86CodeGen
26 foreign import ccall "get_mmap"
27 get_mmap :: IO (Ptr ())
29 foreign import ccall "set_mmap"
30 set_mmap :: Ptr () -> IO ()
33 -- B.ByteString = name of method
34 -- Word32 = entrypoint of method
35 type MMap = M.Map MethodInfo Word32
37 foreign export ccall getMethodEntry :: CUInt -> Ptr () -> Ptr () -> IO CUInt
38 getMethodEntry :: CUInt -> Ptr () -> Ptr () -> IO CUInt
39 getMethodEntry signal_from ptr_mmap ptr_cmap = do
40 mmap <- ptr2mmap ptr_mmap
41 cmap <- ptr2cmap ptr_cmap
43 let w32_from = fromIntegral signal_from
44 let mi@(MethodInfo method cm sig cpidx) = cmap M.! w32_from
45 -- TODO(bernhard): replace parsing with some kind of classpool
46 cls <- parseClassFile $ toString $ cm `B.append` ".class"
47 case M.lookup mi mmap of
49 printf "getMethodEntry(from 0x%08x): no method \"%s\" found. compile it\n" w32_from (show mi)
50 -- TODO(bernhard): maybe we have to load the class first?
51 -- (Or better in X86CodeGen?)
52 let (CMethod _ nt) = (constsPool cls) M.! cpidx
53 hmap <- parseMethod cls (ntName nt)
57 entry <- compileBB hmap' mi
58 return $ fromIntegral $ ((fromIntegral $ ptrToIntPtr entry) :: Word32)
59 Nothing -> error $ (show method) ++ " not found. abort"
60 Just w32 -> return (fromIntegral w32)
64 -- (entry, _) <- testCase "./tests/Fib.class" "fib"
65 -- let int_entry = ((fromIntegral $ ptrToIntPtr entry) :: Word32)
66 -- let mmap = M.insert ("fib" :: String) int_entry M.empty
67 -- mapM_ (\(x,y) -> printf "%s at 0x%08x\n" x y) $ M.toList mmap
68 -- mmap2ptr mmap >>= set_mmap
69 -- demo_mmap -- access Data.Map from C
71 initMethodPool :: IO ()
73 mmap2ptr M.empty >>= set_mmap
74 cmap2ptr M.empty >>= set_cmap
76 compileBB :: MapBB -> MethodInfo -> IO (Ptr Word8)
77 compileBB hmap methodinfo = do
78 mmap <- get_mmap >>= ptr2mmap
79 cmap <- get_cmap >>= ptr2cmap
81 -- TODO(bernhard): replace parsing with some kind of classpool
82 cls <- parseClassFile $ toString $ (classname methodinfo) `B.append` ".class"
83 let ebb = emitFromBB cls hmap
84 (_, Right ((entry, _, _, new_cmap), disasm)) <- runCodeGen ebb () ()
85 let w32_entry = ((fromIntegral $ ptrToIntPtr entry) :: Word32)
87 let mmap' = M.insert methodinfo w32_entry mmap
88 let cmap' = M.union cmap new_cmap -- prefers elements in cmap
89 mmap2ptr mmap' >>= set_mmap
90 cmap2ptr cmap' >>= set_cmap
93 mapM_ (putStrLn . showAtt) disasm
94 -- UNCOMMENT NEXT LINE FOR GDB FUN
96 -- (1) start it with `gdb ./mate' and then `run <classfile>'
97 -- (2) on getLine, press ctrl+c
98 -- (3) `br *0x<addr>'; obtain the address from the disasm above
99 -- (4) `cont' and press enter
103 foreign import ccall "dynamic"
104 code_void :: FunPtr (IO ()) -> (IO ())
106 executeFuncPtr :: Ptr Word8 -> IO ()
107 executeFuncPtr entry = code_void $ ((castPtrToFunPtr entry) :: FunPtr (IO ()))
109 -- TODO(bernhard): make some typeclass magic 'n stuff
110 mmap2ptr :: MMap -> IO (Ptr ())
112 ptr_mmap <- newStablePtr mmap
113 return $ castStablePtrToPtr ptr_mmap
115 ptr2mmap :: Ptr () -> IO MMap
116 ptr2mmap vmap = deRefStablePtr $ ((castPtrToStablePtr vmap) :: StablePtr MMap)
118 cmap2ptr :: CMap -> IO (Ptr ())
120 ptr_cmap <- newStablePtr cmap
121 return $ castStablePtrToPtr ptr_cmap
123 ptr2cmap :: Ptr () -> IO CMap
124 ptr2cmap vmap = deRefStablePtr $ ((castPtrToStablePtr vmap) :: StablePtr cmap)