1 {-# LANGUAGE OverloadedStrings #-}
2 {-# LANGUAGE ForeignFunctionInterface #-}
3 module Mate.MethodPool where
7 import qualified Data.Map as M
8 import qualified Data.ByteString.Lazy as B
13 import Foreign.C.Types
14 import Foreign.C.String
15 import Foreign.StablePtr
20 import Harpy.X86Disassembler
22 import Mate.BasicBlocks
23 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 B.ByteString Word32
37 -- TODO(bernhard): not in use yet
38 -- Word32 = point of method call
39 -- B.ByteString = name of called method
40 type CMap = M.Map Word32 B.ByteString
42 foreign export ccall getMethodEntry :: Ptr () -> CString -> IO CUInt
43 getMethodEntry :: Ptr () -> CString -> IO CUInt
44 getMethodEntry ptr_mmap cstr = do
45 mmap <- ptr2mmap ptr_mmap
46 str' <- peekCString cstr
47 let method = fromString str'
48 case M.lookup method mmap of
50 printf "getMethodEntry: no method found. compile it\n"
51 -- TODO(bernhard): hardcoded... fixme!
52 cls <- parseClassFile "tests/Fib.class"
53 hmap <- parseMethod cls method
56 entry <- compileBB hmap' method
57 let w32_entry = ((fromIntegral $ ptrToIntPtr entry) :: Word32)
58 let mmap' = M.insert method w32_entry mmap
59 mmap2ptr mmap' >>= set_mmap
60 return $ fromIntegral w32_entry
61 Nothing -> error $ (show method) ++ " not found. abort"
62 Just w32 -> return (fromIntegral w32)
66 -- (entry, _) <- testCase "./tests/Fib.class" "fib"
67 -- let int_entry = ((fromIntegral $ ptrToIntPtr entry) :: Word32)
68 -- let mmap = M.insert ("fib" :: String) int_entry M.empty
69 -- mapM_ (\(x,y) -> printf "%s at 0x%08x\n" x y) $ M.toList mmap
70 -- mmap2ptr mmap >>= set_mmap
71 -- demo_mmap -- access Data.Map from C
73 initMethodPool :: IO ()
74 initMethodPool = mmap2ptr M.empty >>= set_mmap
76 compileBB :: MapBB -> B.ByteString -> IO (Ptr Word8)
77 compileBB hmap name = do
78 mmap <- get_mmap >>= ptr2mmap
79 let ebb = emitFromBB hmap
80 (_, Right ((entry, bbstarts, end), disasm)) <- runCodeGen ebb () ()
81 let w32_entry = ((fromIntegral $ ptrToIntPtr entry) :: Word32)
82 let mmap' = M.insert name w32_entry mmap
83 mmap2ptr mmap' >>= set_mmap
85 mapM_ (putStrLn . showAtt) disasm
88 foreign import ccall "dynamic"
89 code_void :: FunPtr (IO ()) -> (IO ())
91 executeFuncPtr :: Ptr Word8 -> IO ()
92 executeFuncPtr entry = code_void $ ((castPtrToFunPtr entry) :: FunPtr (IO ()))
94 mmap2ptr :: MMap -> IO (Ptr ())
96 ptr_mmap <- newStablePtr mmap
97 return $ castStablePtrToPtr ptr_mmap
99 ptr2mmap :: Ptr () -> IO MMap
100 ptr2mmap vmap = deRefStablePtr $ ((castPtrToStablePtr vmap) :: StablePtr MMap)