Mate/X86TrapHandling.hs

   1 {-# LANGUAGE OverloadedStrings #-}
   2 {-# LANGUAGE ForeignFunctionInterface #-}
   3 module Mate.X86TrapHandling (
   4   mateHandler,
   5   register_signal
   6   ) where
   7
   8 import Numeric
   9 import qualified Data.Map as M
  10 import Control.Monad
  11
  12 import Foreign
  13 import Foreign.C.Types
  14
  15 import Harpy hiding (fst)
  16
  17 import Mate.Types
  18 import Mate.NativeSizes
  19 import {-# SOURCE #-} Mate.MethodPool
  20 import Mate.ClassPool
  21 import Mate.X86CodeGen
  22
  23 import Mate.Debug
  24 import Harpy.X86Disassembler
  25
  26 foreign import ccall "register_signal"
  27   register_signal :: IO ()
  28
  29 foreign export ccall mateHandler :: CPtrdiff -> CPtrdiff -> CPtrdiff -> CPtrdiff -> CPtrdiff -> IO CPtrdiff
  30 mateHandler :: CPtrdiff -> CPtrdiff -> CPtrdiff -> CPtrdiff -> CPtrdiff -> IO CPtrdiff
  31 mateHandler reip reax rebx resi resp = do
  32   tmap <- getTrapMap
  33   let reipw32 = fromIntegral reip
  34   (deleteMe, ret_nreip) <- case M.lookup reipw32 tmap of
  35     (Just (StaticMethod patcher)) ->
  36         patchWithHarpy patcher reip >>= delFalse
  37     (Just (StaticField _))  ->
  38         staticFieldHandler reip >>= delTrue
  39     (Just (ObjectField patcher)) ->
  40         patchWithHarpy patcher reip >>= delTrue
  41     (Just (InstanceOf patcher))  ->
  42         patchWithHarpy (patcher reax) reip >>= delFalse
  43     (Just (ThrowException patcher)) ->
  44         patchWithHarpy (patcher reax resp) reip >>= delFalse
  45     (Just (NewObject patcher))   ->
  46         patchWithHarpy patcher reip >>= delTrue
  47     (Just (VirtualCall False mi io_offset)) ->
  48         patchWithHarpy (patchInvoke mi reax reax io_offset) reip
  49         >>= delFalse
  50     (Just (VirtualCall True  mi io_offset)) ->
  51         patchWithHarpy (patchInvoke mi rebx reax io_offset) reip
  52         >>= delFalse
  53     Nothing -> case resi of
  54         0x13371234 -> delFalse (-1)
  55         _ -> error $ "getTrapType: abort :-( eip: "
  56              ++ showHex reip ". " ++ concatMap (`showHex` ", ") (M.keys tmap)
  57   when deleteMe $ setTrapMap $ M.delete reipw32 tmap
  58   return ret_nreip
  59     where
  60       delTrue x = return (True,x)
  61       delFalse x = return (False,x)
  62
  63
  64 patchWithHarpy :: (CPtrdiff -> CodeGen () () CPtrdiff) -> CPtrdiff -> IO CPtrdiff
  65 patchWithHarpy patcher reip = do
  66   -- this is just an upperbound. if the value is to low, patching fails. find
  67   -- something better?
  68   let fixme = 1024
  69   let entry = Just (intPtrToPtr (fromIntegral reip), fixme)
  70   let cgconfig = defaultCodeGenConfig { customCodeBuffer = entry }
  71   (_, Right right) <- runCodeGenWithConfig (withDisasm $ patcher reip) () () cgconfig
  72   when mateDEBUG $ mapM_ (printfJit . printf "patched: %s\n" . showIntel) $ snd right
  73   return $ fst right
  74
  75 withDisasm :: CodeGen e s CPtrdiff -> CodeGen e s (CPtrdiff, [Instruction])
  76 withDisasm patcher = do
  77   reip <- patcher
  78   d <- disassemble
  79   return (reip, d)
  80
  81 staticFieldHandler :: CPtrdiff -> IO CPtrdiff
  82 staticFieldHandler reip = do
  83   -- patch the offset here, first two bytes are part of the insn (opcode + reg)
  84   let imm_ptr = intPtrToPtr (fromIntegral (reip + 2)) :: Ptr CPtrdiff
  85   checkMe <- peek imm_ptr
  86   if checkMe == 0x00000000 then
  87     do
  88       getStaticFieldAddr reip >>= poke imm_ptr
  89       return reip
  90     else error "staticFieldHandler: something is wrong here. abort.\n"
  91
  92 patchInvoke :: MethodInfo -> CPtrdiff -> CPtrdiff -> IO NativeWord -> CPtrdiff -> CodeGen e s CPtrdiff
  93 patchInvoke (MethodInfo methname _ msig)  method_table table2patch io_offset reip = do
  94   vmap <- liftIO getVirtualMap
  95   let newmi = MethodInfo methname (vmap M.! fromIntegral method_table) msig
  96   offset <- liftIO io_offset
  97   (entryAddr, _) <- liftIO $ getMethodEntry newmi
  98   call32Eax (Disp offset)
  99   -- patch entry in table
 100   let call_insn = intPtrToPtr . fromIntegral $ table2patch + fromIntegral offset
 101   liftIO $ poke call_insn entryAddr
 102   return reip