Mate/MethodPool.hs

   1 {-# LANGUAGE OverloadedStrings #-}
   2 {-# LANGUAGE ForeignFunctionInterface #-}
   3 module Mate.MethodPool where
   4
   5 import Data.Binary
   6 import qualified Data.Map as M
   7
   8
   9 import Text.Printf
  10
  11 import Foreign.Ptr
  12 import Foreign.C.Types
  13 import Foreign.C.String
  14 import Foreign.StablePtr
  15
  16 import Mate.X86CodeGen
  17
  18
  19 foreign import ccall "get_mmap"
  20   get_mmap :: IO (Ptr ())
  21
  22 foreign import ccall "set_mmap"
  23   set_mmap :: Ptr () -> IO ()
  24
  25 foreign import ccall "demo_mmap"
  26   demo_mmap :: IO ()
  27
  28
  29 type MMap = M.Map String Word32
  30
  31 foreign export ccall getMethodEntry :: Ptr () -> CString -> IO CUInt
  32 getMethodEntry :: Ptr () -> CString -> IO CUInt
  33 getMethodEntry ptr_mmap cstr = do
  34   mmap <- deRefStablePtr $ ((castPtrToStablePtr ptr_mmap) :: StablePtr MMap)
  35   k <- peekCString cstr
  36   case M.lookup k mmap of
  37     Nothing -> return 0
  38     Just w32 -> return (fromIntegral w32)
  39
  40 t_01 :: IO ()
  41 t_01 = do
  42   (entry, _) <- testCase "./tests/Fib.class" "fib"
  43   let int_entry = ((fromIntegral $ ptrToIntPtr entry) :: Word32)
  44   let mmap = M.insert ("fib" :: String) int_entry M.empty
  45   mapM_ (\(x,y) -> printf "%s at 0x%08x\n" x y) $ M.toList mmap
  46   ptr_mmap <- newStablePtr mmap
  47   set_mmap $ castStablePtrToPtr ptr_mmap
  48   demo_mmap -- access Data.Map from C