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
  26 foreign import ccall "wrapper"
  27   wrap :: (CUInt -> Ptr SigInfo -> Ptr Context -> IO ()) -> IO (FunPtr (CUInt -> Ptr SigInfo -> Ptr Context -> IO ()))
  28
  29 foreign import ccall "prototypes.h"
  30   registerSignalHandlers2 :: FunPtr (CUInt -> Ptr SigInfo -> Ptr Context -> IO ()) -> IO ()
  31
  32 type SigInfo = ()
  33 type Context = ()
  34
  35 data MateExecutionCtx = Ctx { compiledMethods :: M.Map Int Int }
  36 emptyCtx :: MateExecutionCtx
  37 emptyCtx = Ctx { compiledMethods = M.empty }
  38
  39 type AppDomain = ()  -- classpath etc
  40
  41 -- add AppDomain to MateExecutionCtx in order to get linear access
  42
  43 runMateKernel :: AppDomain -> IO ()
  44 runMateKernel _ = do
  45   compileAndRun
  46
  47
  48 -- use FFI to unpack sigInfo and ctx....
  49 handler mateCtx signal sigInfo ctx = do
  50   putStr "handler got me."
  51   print signal
  52   putStr "content of code cache: "
  53   actualCtx <- readIORef mateCtx
  54   let methods = compiledMethods actualCtx
  55   random <- senseless
  56   print methods
  57   -- write back new compiled stuff
  58   writeIORef mateCtx (Ctx {compiledMethods = M.insert random random methods})
  59   _ <- getChar
  60   compileAndRun -- tail
  61
  62 main :: IO ()
  63 main = do
  64
  65   -- load application context (classpath etc)
  66   let appDomain = undefined
  67
  68   ctx <- newIORef emptyCtx
  69
  70   -- curry context into handler
  71   actualHandler <- wrap (handler ctx)
  72
  73   -- perform global setup
  74   registerSignalHandlers2 actualHandler
  75
  76   runMateKernel appDomain
  77
  78
  79 compileAndRun :: IO ()
  80 compileAndRun = do
  81   entryPtr <- memalign 0x1000 0x2
  82   poke entryPtr (0xffff9090 :: Word32) -- SIGILL
  83   --poke entryPtr (0xc390 :: Word16) -- nop (0x90); ret(0xc3) (little endian order)
  84   let i_entry = (fromIntegral $ ptrToIntPtr entryPtr) :: Int
  85   -- 0x7 = PROT_{READ,WRITE,EXEC}
  86   mprotect (fromIntegral i_entry) 2 0x7
  87   _ <- printf "entry point: 0x%08x\n" i_entry
  88   code_void $ castPtrToFunPtr entryPtr
  89   putStrLn "welcome back"
  90
  91
  92 senseless :: IO Int
  93 senseless = getStdRandom (randomR (1,100))