Mate/X86TrapHandling.hs

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