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 qualified Data.ByteString.Lazy as B
  11
  12 import Foreign
  13 import Foreign.C.Types
  14
  15 import Harpy
  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 -> IO CPtrdiff
  30 mateHandler :: CPtrdiff -> CPtrdiff -> CPtrdiff -> CPtrdiff -> IO CPtrdiff
  31 mateHandler reip reax rebx resi = do
  32   tmap <- getTrapMap
  33   case M.lookup (fromIntegral reip) tmap of
  34     (Just (StaticMethod _)) -> patchWithHarpy patchStaticCall reip
  35     (Just (StaticField _))  -> staticFieldHandler reip
  36     (Just (InstanceOf cn))  -> patchWithHarpy (`patchInstanceOf` cn) reip
  37     (Just (NewObject cn))   -> patchWithHarpy (`patchNewObject` cn) reip
  38     (Just (VirtualCall False _ io_offset)) ->
  39           patchWithHarpy (patchInvoke reax reax io_offset) reip
  40     (Just (VirtualCall True  _ io_offset)) ->
  41           patchWithHarpy (patchInvoke rebx reax io_offset) reip
  42     Nothing -> case resi of
  43         0x13371234 -> return (-1)
  44         _ -> error $ "getTrapType: abort :-( " ++ (showHex reip ". ")
  45              ++ (concatMap (`showHex` ", ") (M.keys tmap))
  46
  47 patchWithHarpy :: (CPtrdiff -> CodeGen () () CPtrdiff) -> CPtrdiff -> IO CPtrdiff
  48 patchWithHarpy patcher reip = do
  49   -- this is just an upperbound. if the value is to low, patching fails. find
  50   -- something better?
  51   let fixme = 1024
  52   let entry = Just (intPtrToPtr (fromIntegral reip), fixme)
  53   let cgconfig = defaultCodeGenConfig { customCodeBuffer = entry }
  54   (_, Right right) <- runCodeGenWithConfig (withDisasm $ patcher reip) () () cgconfig
  55   mapM_ (printfJit . printf "patched: %s\n" . showAtt) $ snd right
  56   return reip
  57
  58 withDisasm :: CodeGen e s CPtrdiff -> CodeGen e s (CPtrdiff, [Instruction])
  59 withDisasm patcher = do
  60   reip <- patcher
  61   d <- disassemble
  62   return (reip, d)
  63
  64 patchStaticCall :: CPtrdiff -> CodeGen e s CPtrdiff
  65 patchStaticCall reip = do
  66   entryAddr <- liftIO $ getMethodEntry reip 0
  67   call (fromIntegral (entryAddr - (reip + 5)) :: NativeWord)
  68   return reip
  69
  70
  71 staticFieldHandler :: CPtrdiff -> IO CPtrdiff
  72 staticFieldHandler reip = do
  73   -- patch the offset here, first two bytes are part of the insn (opcode + reg)
  74   let imm_ptr = intPtrToPtr (fromIntegral (reip + 2)) :: Ptr CPtrdiff
  75   checkMe <- peek imm_ptr
  76   if checkMe == 0x00000000 then
  77     do
  78       getStaticFieldAddr reip >>= poke imm_ptr
  79       return reip
  80     else error "staticFieldHandler: something is wrong here. abort.\n"
  81
  82 patchInstanceOf :: CPtrdiff -> B.ByteString -> CodeGen e s CPtrdiff
  83 patchInstanceOf reip classname = do
  84   mtable <- liftIO $ getMethodTable classname
  85   mov edx mtable
  86   return reip
  87
  88 patchNewObject :: CPtrdiff -> B.ByteString -> CodeGen e s CPtrdiff
  89 patchNewObject reip classname = do
  90   objsize <- liftIO $ getObjectSize classname
  91   push32 objsize
  92   callMalloc
  93   mtable <- liftIO $ getMethodTable classname
  94   mov (Disp 0, eax) mtable
  95   return reip
  96
  97 patchInvoke :: CPtrdiff -> CPtrdiff -> IO NativeWord -> CPtrdiff -> CodeGen e s CPtrdiff
  98 patchInvoke method_table table2patch io_offset reip = do
  99   offset <- liftIO io_offset
 100   entryAddr <- liftIO $ getMethodEntry reip method_table
 101   call32_eax (Disp offset)
 102   -- patch entry in table
 103   let call_insn = intPtrToPtr . fromIntegral $ table2patch + fromIntegral offset
 104   liftIO $ poke call_insn entryAddr
 105   return reip