nativeMaschine: s/unsigned int/ptrdiff_t/g

[mate.git] / Mate / X86TrapHandling.hs

diff --git a/Mate/X86TrapHandling.hs b/Mate/X86TrapHandling.hs
index 882a541f1eefb7b5fe89eed22285d7a2d4cf524e..6ec0124f2c56e9ec347e982d37eeb3e6d6e8c648 100644 (file)
--- a/Mate/X86TrapHandling.hs
+++ b/Mate/X86TrapHandling.hs
@@ -2,7 +2,10 @@
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE ForeignFunctionInterface #-}
 #include "debug.h"
-module Mate.X86TrapHandling where
+module Mate.X86TrapHandling (
+  mateHandler,
+  register_signal
+  ) where
 
 import qualified Data.Map as M
 
@@ -10,55 +13,54 @@ import Foreign
 import Foreign.C.Types
 
 import Mate.Types
-import Mate.MethodPool
+import {-# SOURCE #-} Mate.MethodPool
 import Mate.ClassPool
 
 foreign import ccall "register_signal"
   register_signal :: IO ()
 
+data TrapType =
+    StaticMethodCall
+  | StaticFieldAccess
+  | VirtualMethodCall Bool
+  | InterfaceMethodCall Bool
 
-getTrapType :: CUInt -> CUInt -> IO CUInt
-getTrapType signal_from from2 = do
-  tmap <- getTrapMap
+getTrapType :: TrapMap -> CPtrdiff -> CPtrdiff -> TrapType
+getTrapType tmap signal_from from2 =
   case M.lookup (fromIntegral signal_from) tmap of
-    (Just (StaticMethod _)) -> return 0
-    (Just (StaticField _)) -> return 2
+    (Just (StaticMethod _)) -> StaticMethodCall
+    (Just (StaticField _)) -> StaticFieldAccess
     (Just _) -> error "getTrapMap: doesn't happen"
     -- maybe we've a hit on the second `from' value
     Nothing -> case M.lookup (fromIntegral from2) tmap of
-      (Just (VirtualMethod True _)) -> return 1
-      (Just (VirtualMethod False _)) -> return 5
-      (Just (InterfaceMethod True _)) -> return 4
-      (Just (InterfaceMethod False _)) -> return 8
+      (Just (VirtualMethod imm8 _)) -> VirtualMethodCall imm8
+      (Just (InterfaceMethod imm8 _)) -> InterfaceMethodCall imm8
       (Just _) -> error "getTrapType: abort #1 :-("
       Nothing -> error $ "getTrapType: abort #2 :-(" ++ show signal_from ++ ", " ++ show from2 ++ ", " ++ show tmap
 
-foreign export ccall mateHandler :: CUInt -> CUInt -> CUInt -> CUInt -> IO CUInt
-mateHandler :: CUInt -> CUInt -> CUInt -> CUInt -> IO CUInt
+foreign export ccall mateHandler :: CPtrdiff -> CPtrdiff -> CPtrdiff -> CPtrdiff -> IO CPtrdiff
+mateHandler :: CPtrdiff -> CPtrdiff -> CPtrdiff -> CPtrdiff -> IO CPtrdiff
 mateHandler eip eax ebx esp = do
   callerAddr <- callerAddrFromStack esp
-  blah <- getTrapType eip callerAddr
-  case blah of
-    0 -> staticCallHandler eip
-    1 -> invokeHandler eax eax esp True
-    5 -> invokeHandler eax eax esp False
-    4 -> invokeHandler eax ebx esp True
-    8 -> invokeHandler eax ebx esp False
-    2 -> staticFieldHandler eip
-    x -> error $ "wtf: " ++ show x
+  tmap <- getTrapMap
+  case getTrapType tmap eip callerAddr of
+    StaticMethodCall  -> staticCallHandler eip
+    StaticFieldAccess -> staticFieldHandler eip
+    VirtualMethodCall imm8   -> invokeHandler eax eax esp imm8
+    InterfaceMethodCall imm8 -> invokeHandler eax ebx esp imm8
 
-staticCallHandler :: CUInt -> IO CUInt
+staticCallHandler :: CPtrdiff -> IO CPtrdiff
 staticCallHandler eip = do
   -- the actual insn to patch is displaced by two bytes
   let insn_ptr = intPtrToPtr (fromIntegral (eip - 2)) :: Ptr CUChar
   -- call offset is displaced by one byte
-  let imm_ptr = intPtrToPtr (fromIntegral (eip - 1)) :: Ptr CUInt
+  let imm_ptr = intPtrToPtr (fromIntegral (eip - 1)) :: Ptr CPtrdiff
   -- in codegen we set the immediate to some magic value
   -- in order to produce a SIGILL signal. we also do a safety
   -- check here, if we're really the "owner" of this signal.
   checkMe <- peek imm_ptr
-  case checkMe == 0x90ffff90 of
-    True -> do
+  if checkMe == 0x90ffff90 then
+    do
       entryAddr <- getMethodEntry eip 0
       poke insn_ptr 0xe8 -- call opcode
       -- it's a relative call, so we have to calculate the offset. why "+ 3"?
@@ -67,20 +69,20 @@ staticCallHandler eip = do
       -- (3) offset is calculated wrt to the beginning of the next insn
       poke imm_ptr (entryAddr - (eip + 3))
       return (eip - 2)
-    False -> error "staticCallHandler: something is wrong here. abort\n"
+    else error "staticCallHandler: something is wrong here. abort\n"
 
-staticFieldHandler :: CUInt -> IO CUInt
+staticFieldHandler :: CPtrdiff -> IO CPtrdiff
 staticFieldHandler eip = do
   -- patch the offset here, first two bytes are part of the insn (opcode + reg)
-  let imm_ptr = intPtrToPtr (fromIntegral (eip + 2)) :: Ptr CUInt
+  let imm_ptr = intPtrToPtr (fromIntegral (eip + 2)) :: Ptr CPtrdiff
   checkMe <- peek imm_ptr
-  case checkMe == 0x00000000 of
-    True -> do
+  if checkMe == 0x00000000 then
+    do
       getStaticFieldAddr eip >>= poke imm_ptr
       return eip
-    False -> error "staticFieldHandler: something is wrong here. abort.\n"
+    else error "staticFieldHandler: something is wrong here. abort.\n"
 
-invokeHandler :: CUInt -> CUInt -> CUInt -> Bool -> IO CUInt
+invokeHandler :: CPtrdiff -> CPtrdiff -> CPtrdiff -> Bool -> IO CPtrdiff
 invokeHandler method_table table2patch esp imm8 = do
   -- table2patch: note, that can be a method-table or a interface-table
   callerAddr <- callerAddrFromStack esp
@@ -91,18 +93,18 @@ invokeHandler method_table table2patch esp imm8 = do
   return entryAddr
 
 
-callerAddrFromStack :: CUInt -> IO CUInt
+callerAddrFromStack :: CPtrdiff -> IO CPtrdiff
 callerAddrFromStack = peek . intPtrToPtr . fromIntegral
 
-offsetOfCallInsn8 :: CUInt -> IO CUInt
+offsetOfCallInsn8 :: CPtrdiff -> IO CPtrdiff
 offsetOfCallInsn8 esp = do
-  let ret_ptr = intPtrToPtr (fromIntegral esp) :: Ptr CUInt
+  let ret_ptr = intPtrToPtr (fromIntegral esp) :: Ptr CPtrdiff
   ret <- peek ret_ptr
   retval <- peek (intPtrToPtr (fromIntegral (ret - 1)) :: Ptr CUChar)
   return $ fromIntegral retval
 
-offsetOfCallInsn32 :: CUInt -> IO CUInt
+offsetOfCallInsn32 :: CPtrdiff -> IO CPtrdiff
 offsetOfCallInsn32 esp = do
-  let ret_ptr = intPtrToPtr (fromIntegral esp) :: Ptr CUInt
+  let ret_ptr = intPtrToPtr (fromIntegral esp) :: Ptr CPtrdiff
   ret <- peek ret_ptr
   peek (intPtrToPtr $ fromIntegral (ret - 4))