scratch: sync sketch code for FFI,Signal...

[mate.git] / scratch / ffiTest / trapTest.hs

diff --git a/scratch/ffiTest/trapTest.hs b/scratch/ffiTest/trapTest.hs
new file mode 100644 (file)
index 0000000..409c9a3
--- /dev/null
+++ b/scratch/ffiTest/trapTest.hs
@@ -0,0 +1,107 @@
+{-#LANGUAGE ForeignFunctionInterface #-}
+
+module Main where
+
+import qualified Data.Map as M
+
+import Data.Word
+import Text.Printf
+import Foreign
+import Foreign.C.Types
+
+import Data.IORef
+
+import System.Random
+
+foreign import ccall "dynamic"
+   code_void :: FunPtr (IO ()) -> (IO ())
+
+foreign import ccall "static sys/mman.h"
+  mprotect :: CUInt -> CUInt -> Int -> IO ()
+
+foreign import ccall "static stdlib.h"
+  memalign :: CUInt -> CUInt -> IO (Ptr a)
+
+foreign import ccall safe "prototypes.h"
+  registerSignalHandlers :: IO ()
+
+foreign import ccall "wrapper"
+  wrap :: (CUInt -> Ptr SigInfo -> Ptr Context -> IO ()) -> IO (FunPtr (CUInt -> Ptr SigInfo -> Ptr Context -> IO ()))
+
+foreign import ccall "prototypes.h"
+  registerSignalHandlers2 :: FunPtr (CUInt -> Ptr SigInfo -> Ptr Context -> IO ()) -> IO ()
+
+foreign export ccall
+    mateTrapHandler :: CUInt -> Ptr SigInfo -> Ptr Context -> CUInt -> IO ()
+
+type SigInfo = ()
+type Context = ()              
+
+data MateExecutionCtx = Ctx { compiledMethods :: M.Map Int Int }
+emptyCtx :: MateExecutionCtx
+emptyCtx = Ctx { compiledMethods = M.empty }
+
+type AppDomain = ()  -- classpath etc
+
+-- add AppDomain to MateExecutionCtx in order to get linear access
+
+runMateKernel :: AppDomain -> IO ()
+runMateKernel _ = do    
+  compileAndRun
+
+-- use FFI to unpack sigInfo and ctx....
+handler mateCtx signal sigInfo ctx = do 
+  putStr "handler got me."
+  print signal
+  putStr "content of code cache: " 
+  actualCtx <- readIORef mateCtx
+  let methods = compiledMethods actualCtx
+  random <- senseless
+  print methods
+  -- write back new compiled stuff
+  writeIORef mateCtx (Ctx {compiledMethods = M.insert random random methods})
+  _ <- getChar
+  compileAndRun -- tail
+
+main :: IO ()
+main = do 
+
+  -- load application context (classpath etc)
+  let appDomain = undefined
+
+  ctx <- newIORef emptyCtx
+
+  -- curry context into handler
+  actualHandler <- wrap (handler ctx)
+  
+  -- perform global setup
+  registerSignalHandlers2 actualHandler
+  
+  runMateKernel appDomain
+
+
+compileAndRun :: IO ()
+compileAndRun = do
+  entryPtr <- memalign 0x1000 0x2 
+  poke entryPtr (0xffff9090 :: Word32) -- SIGILL
+  --poke entryPtr (0xc390 :: Word16) -- nop (0x90); ret(0xc3) (little endian order)
+  let i_entry = (fromIntegral $ ptrToIntPtr entryPtr) :: Int
+  -- 0x7 = PROT_{READ,WRITE,EXEC}
+  mprotect (fromIntegral i_entry) 2 0x7
+  _ <- printf "entry point: 0x%08x\n" i_entry
+  code_void $ castPtrToFunPtr entryPtr
+  putStrLn "welcome back"
+
+
+senseless :: IO Int
+senseless = getStdRandom (randomR (1,100))
+
+
+mateTrapHandler :: CUInt -> Ptr SigInfo -> Ptr Context -> CUInt -> IO ()
+mateTrapHandler signal sigInfo ctx eip = do
+  putStr "mateTrapHandler says: "
+  let eip' = (fromIntegral eip) :: Int
+  printf "source, eip: 0x%08x" eip'
+  print eip'
+
+