scratch/ffiTest/trapTest.hs

   1 {-#LANGUAGE ForeignFunctionInterface #-}
   2
   3 module Main where
   4
   5 import qualified Data.Map as M
   6
   7 import Data.Word
   8 import Text.Printf
   9 import Foreign
  10 import Foreign.C.Types
  11
  12 import Data.IORef
  13
  14 import System.Random
  15
  16 foreign import ccall "dynamic"
  17    code_void :: FunPtr (IO ()) -> (IO ())
  18
  19 foreign import ccall "static sys/mman.h"
  20   mprotect :: CUInt -> CUInt -> Int -> IO ()
  21
  22 foreign import ccall "static stdlib.h"
  23   memalign :: CUInt -> CUInt -> IO (Ptr a)
  24
  25 foreign import ccall safe "prototypes.h"
  26   registerSignalHandlers :: IO ()
  27
  28 foreign import ccall "wrapper"
  29   wrap :: (CUInt -> Ptr SigInfo -> Ptr Context -> IO ()) -> IO (FunPtr (CUInt -> Ptr SigInfo -> Ptr Context -> IO ()))
  30
  31 foreign import ccall "prototypes.h"
  32   registerSignalHandlers2 :: FunPtr (CUInt -> Ptr SigInfo -> Ptr Context -> IO ()) -> IO ()
  33
  34 foreign export ccall
  35     mateTrapHandler :: CUInt -> Ptr SigInfo -> Ptr Context -> CUInt -> IO ()
  36
  37 type SigInfo = ()
  38 type Context = ()
  39
  40 data MateExecutionCtx = Ctx { compiledMethods :: M.Map Int Int }
  41 emptyCtx :: MateExecutionCtx
  42 emptyCtx = Ctx { compiledMethods = M.empty }
  43
  44 type AppDomain = ()  -- classpath etc
  45
  46 -- add AppDomain to MateExecutionCtx in order to get linear access
  47
  48 runMateKernel :: AppDomain -> IO ()
  49 runMateKernel _ = do
  50   compileAndRun
  51
  52 -- use FFI to unpack sigInfo and ctx....
  53 handler mateCtx signal sigInfo ctx = do
  54   putStr "handler got me."
  55   print signal
  56   putStr "content of code cache: "
  57   actualCtx <- readIORef mateCtx
  58   let methods = compiledMethods actualCtx
  59   random <- senseless
  60   print methods
  61   -- write back new compiled stuff
  62   writeIORef mateCtx (Ctx {compiledMethods = M.insert random random methods})
  63   _ <- getChar
  64   compileAndRun -- tail
  65
  66 main :: IO ()
  67 main = do
  68
  69   -- load application context (classpath etc)
  70   let appDomain = undefined
  71
  72   ctx <- newIORef emptyCtx
  73
  74   -- curry context into handler
  75   actualHandler <- wrap (handler ctx)
  76
  77   -- perform global setup
  78   registerSignalHandlers2 actualHandler
  79
  80   runMateKernel appDomain
  81
  82
  83 compileAndRun :: IO ()
  84 compileAndRun = do
  85   entryPtr <- memalign 0x1000 0x2
  86   poke entryPtr (0xffff9090 :: Word32) -- SIGILL
  87   --poke entryPtr (0xc390 :: Word16) -- nop (0x90); ret(0xc3) (little endian order)
  88   let i_entry = (fromIntegral $ ptrToIntPtr entryPtr) :: Int
  89   -- 0x7 = PROT_{READ,WRITE,EXEC}
  90   mprotect (fromIntegral i_entry) 2 0x7
  91   _ <- printf "entry point: 0x%08x\n" i_entry
  92   code_void $ castPtrToFunPtr entryPtr
  93   putStrLn "welcome back"
  94
  95
  96 senseless :: IO Int
  97 senseless = getStdRandom (randomR (1,100))
  98
  99
 100 mateTrapHandler :: CUInt -> Ptr SigInfo -> Ptr Context -> CUInt -> IO ()
 101 mateTrapHandler signal sigInfo ctx eip = do
 102   putStr "mateTrapHandler says: "
 103   let eip' = (fromIntegral eip) :: Int
 104   printf "source, eip: 0x%08x" eip'
 105   print eip'
 106
 107