yuzu/unicorn
1
0
Fork 0
mirror of https://github.com/yuzu-emu/unicorn.git synced 2024-12-22 23:05:34 +00:00
Code Issues Packages Projects Releases Wiki Activity

Updates to Haskell bindings (#667)

Browse source 
* [haskell] Added uc_context_* support

As per issue #662

* [haskell] Updated bindings for commit 4083b87032

Updated for introduction of UC_HOOK_MEM_READ_AFTER.

* [haskell] Style fixes
This commit is contained in:
Adrian Herrera 2016-10-30 03:51:02 +01:00 committed by Nguyen Anh Quynh
parent 4d5738eeb5
commit 19028f41f6
15 changed files with 594 additions and 410 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

116
bindings/haskell/src/Unicorn.hs
View file

@ -9,41 +9,47 @@ framework based on QEMU.
Further information is available at <http://www.unicorn-engine.org>.
-}
module Unicorn (
-- * Emulator control
Emulator,
Engine,
Architecture(..),
Mode(..),
QueryType(..),
runEmulator,
open,
query,
start,
stop,
module Unicorn
( -- * Emulator control
Emulator
, Engine
, Architecture(..)
, Mode(..)
, QueryType(..)
, runEmulator
, open
, query
, start
, stop
-- * Register operations
regWrite,
regRead,
-- * Register operations
, regWrite
, regRead
-- * Memory operations
MemoryPermission(..),
MemoryRegion(..),
memWrite,
memRead,
memMap,
memUnmap,
memProtect,
memRegions,
-- * Memory operations
, MemoryPermission(..)
, MemoryRegion(..)
, memWrite
, memRead
, memMap
, memUnmap
, memProtect
, memRegions
-- * Error handling
Error(..),
errno,
strerror,
-- * Context operations
, Context
, contextAlloc
, contextSave
, contextRestore
-- * Misc.
version,
) where
-- * Error handling
, Error(..)
, errno
, strerror
-- * Misc.
, version
) where
import Control.Monad (liftM)
import Control.Monad.Trans.Class (lift)
@ -132,8 +138,8 @@ stop uc = do
-------------------------------------------------------------------------------
-- | Write to register.
regWrite :: Reg r =>
Engine -- ^ 'Unicorn' engine handle
regWrite :: Reg r
=> Engine -- ^ 'Unicorn' engine handle
-> r -- ^ Register ID to write to
-> Int64 -- ^ Value to write to register
-> Emulator () -- ^ An 'Error' on failure
@ -147,8 +153,8 @@ regWrite uc regId value = do
left err
-- | Read register value.
regRead :: Reg r =>
Engine -- ^ 'Unicorn' engine handle
regRead :: Reg r
=> Engine -- ^ 'Unicorn' engine handle
-> r -- ^ Register ID to read from
-> Emulator Int64 -- ^ The value read from the register on success,
-- or an 'Error' on failure
@ -259,6 +265,46 @@ memRegions uc = do
else
left err
-------------------------------------------------------------------------------
-- Context operations
-------------------------------------------------------------------------------
-- | Allocate a region that can be used to perform quick save/rollback of the
-- CPU context, which includes registers and some internal metadata. Contexts
-- may not be shared across engine instances with differing architectures or
-- modes.
contextAlloc :: Engine -- ^ 'Unicon' engine handle
-> Emulator Context -- ^ A CPU context
contextAlloc uc = do
(err, contextPtr) <- lift $ ucContextAlloc uc
if err == ErrOk then
-- Return a CPU context if ucContextAlloc completed successfully
lift $ mkContext contextPtr
else
left err
-- | Save a copy of the internal CPU context.
contextSave :: Engine -- ^ 'Unicorn' engine handle
-> Context -- ^ A CPU context
-> Emulator () -- ^ An error on failure
contextSave uc context = do
err <- lift $ ucContextSave uc context
if err == ErrOk then
right ()
else
left err
-- | Restore the current CPU context from a saved copy.
contextRestore :: Engine -- ^ 'Unicorn' engine handle
-> Context -- ^ A CPU context
-> Emulator () -- ^ An error on failure
contextRestore uc context = do
err <- lift $ ucContextRestore uc context
if err == ErrOk then
right ()
else
left err
-------------------------------------------------------------------------------
-- Misc.
-------------------------------------------------------------------------------

21
bindings/haskell/src/Unicorn/CPU/Arm.chs
View file

@ -8,22 +8,25 @@ License : GPL-2
Definitions for the ARM architecture.
-}
module Unicorn.CPU.Arm (
Register(..),
) where
module Unicorn.CPU.Arm
(
Register(..)
) where
import Unicorn.Internal.Core (Reg)
{# context lib="unicorn" #}
{# context lib = "unicorn" #}
#include <unicorn/arm.h>
-- | ARM registers.
{# enum uc_arm_reg as Register
{underscoreToCase}
omit (UC_ARM_REG_INVALID,
UC_ARM_REG_ENDING)
with prefix="UC_ARM_REG_"
deriving (Show, Eq, Bounded) #}
{ underscoreToCase }
omit ( UC_ARM_REG_INVALID
, UC_ARM_REG_ENDING
)
with prefix = "UC_ARM_REG_"
deriving (Show, Eq, Bounded)
#}
instance Reg Register

21
bindings/haskell/src/Unicorn/CPU/Arm64.chs
View file

@ -8,22 +8,25 @@ License : GPL-2
Definitions for the ARM64 (ARMv8) architecture.
-}
module Unicorn.CPU.Arm64 (
Register(..),
) where
module Unicorn.CPU.Arm64
(
Register(..)
) where
import Unicorn.Internal.Core (Reg)
{# context lib="unicorn" #}
{# context lib = "unicorn" #}
#include <unicorn/arm64.h>
-- | ARM64 registers.
{# enum uc_arm64_reg as Register
{underscoreToCase}
omit (UC_ARM64_REG_INVALID,
UC_ARM64_REG_ENDING)
with prefix="UC_ARM64_REG_"
deriving (Show, Eq, Bounded) #}
{ underscoreToCase }
omit ( UC_ARM64_REG_INVALID
, UC_ARM64_REG_ENDING
)
with prefix = "UC_ARM64_REG_"
deriving (Show, Eq, Bounded)
#}
instance Reg Register

21
bindings/haskell/src/Unicorn/CPU/M68k.chs
View file

@ -8,22 +8,25 @@ License : GPL-2
Definitions for the MK68K architecture.
-}
module Unicorn.CPU.M68k (
Register(..),
) where
module Unicorn.CPU.M68k
(
Register(..)
) where
import Unicorn.Internal.Core (Reg)
{# context lib="unicorn" #}
{# context lib = "unicorn" #}
#include <unicorn/m68k.h>
-- | M68K registers.
{# enum uc_m68k_reg as Register
{underscoreToCase}
omit (UC_M68K_REG_INVALID,
UC_M68K_REG_ENDING)
with prefix="UC_M68K_REG_"
deriving (Show, Eq, Bounded) #}
{ underscoreToCase }
omit ( UC_M68K_REG_INVALID
, UC_M68K_REG_ENDING
)
with prefix = "UC_M68K_REG_"
deriving (Show, Eq, Bounded)
#}
instance Reg Register

86
bindings/haskell/src/Unicorn/CPU/Mips.chs
View file

@ -8,54 +8,58 @@ License : GPL-2
Definitions for the MIPS architecture.
-}
module Unicorn.CPU.Mips (
Register(..),
) where
module Unicorn.CPU.Mips
(
Register(..)
) where
import Unicorn.Internal.Core (Reg)
{# context lib="unicorn" #}
{# context lib = "unicorn" #}
#include <unicorn/mips.h>
-- | MIPS registers.
{# enum UC_MIPS_REG as Register
{underscoreToCase,
UC_MIPS_REG_0 as Reg0,
UC_MIPS_REG_1 as Reg1,
UC_MIPS_REG_2 as Reg2,
UC_MIPS_REG_3 as Reg3,
UC_MIPS_REG_4 as Reg4,
UC_MIPS_REG_5 as Reg5,
UC_MIPS_REG_6 as Reg6,
UC_MIPS_REG_7 as Reg7,
UC_MIPS_REG_8 as Reg8,
UC_MIPS_REG_9 as Reg9,
UC_MIPS_REG_10 as Reg10,
UC_MIPS_REG_11 as Reg11,
UC_MIPS_REG_12 as Reg12,
UC_MIPS_REG_13 as Reg13,
UC_MIPS_REG_14 as Reg14,
UC_MIPS_REG_15 as Reg15,
UC_MIPS_REG_16 as Reg16,
UC_MIPS_REG_17 as Reg17,
UC_MIPS_REG_18 as Reg18,
UC_MIPS_REG_19 as Reg19,
UC_MIPS_REG_20 as Reg20,
UC_MIPS_REG_21 as Reg21,
UC_MIPS_REG_22 as Reg22,
UC_MIPS_REG_23 as Reg23,
UC_MIPS_REG_24 as Reg24,
UC_MIPS_REG_25 as Reg25,
UC_MIPS_REG_26 as Reg26,
UC_MIPS_REG_27 as Reg27,
UC_MIPS_REG_28 as Reg28,
UC_MIPS_REG_29 as Reg29,
UC_MIPS_REG_30 as Reg30,
UC_MIPS_REG_31 as Reg31}
omit (UC_MIPS_REG_INVALID,
UC_MIPS_REG_ENDING)
with prefix="UC_MIPS_REG_"
deriving (Show, Eq, Bounded) #}
{ underscoreToCase
, UC_MIPS_REG_0 as Reg0g
, UC_MIPS_REG_1 as Reg1g
, UC_MIPS_REG_2 as Reg2g
, UC_MIPS_REG_3 as Reg3g
, UC_MIPS_REG_4 as Reg4g
, UC_MIPS_REG_5 as Reg5g
, UC_MIPS_REG_6 as Reg6g
, UC_MIPS_REG_7 as Reg7g
, UC_MIPS_REG_8 as Reg8g
, UC_MIPS_REG_9 as Reg9g
, UC_MIPS_REG_10 as Reg10g
, UC_MIPS_REG_11 as Reg11g
, UC_MIPS_REG_12 as Reg12g
, UC_MIPS_REG_13 as Reg13g
, UC_MIPS_REG_14 as Reg14g
, UC_MIPS_REG_15 as Reg15g
, UC_MIPS_REG_16 as Reg16g
, UC_MIPS_REG_17 as Reg17g
, UC_MIPS_REG_18 as Reg18g
, UC_MIPS_REG_19 as Reg19g
, UC_MIPS_REG_20 as Reg20g
, UC_MIPS_REG_21 as Reg21g
, UC_MIPS_REG_22 as Reg22g
, UC_MIPS_REG_23 as Reg23g
, UC_MIPS_REG_24 as Reg24g
, UC_MIPS_REG_25 as Reg25g
, UC_MIPS_REG_26 as Reg26g
, UC_MIPS_REG_27 as Reg27g
, UC_MIPS_REG_28 as Reg28g
, UC_MIPS_REG_29 as Reg29g
, UC_MIPS_REG_30 as Reg30g
, UC_MIPS_REG_31 as Reg31
}
omit ( UC_MIPS_REG_INVALID
, UC_MIPS_REG_ENDING
)
with prefix = "UC_MIPS_REG_"
deriving (Show, Eq, Bounded)
#}
instance Reg Register

21
bindings/haskell/src/Unicorn/CPU/Sparc.chs
View file

@ -8,22 +8,25 @@ License : GPL-2
Definitions for the SPARC architecture.
-}
module Unicorn.CPU.Sparc (
Register(..),
) where
module Unicorn.CPU.Sparc
(
Register(..)
) where
import Unicorn.Internal.Core (Reg)
{# context lib="unicorn" #}
{# context lib = "unicorn" #}
#include <unicorn/sparc.h>
-- | SPARC registers.
{# enum uc_sparc_reg as Register
{underscoreToCase}
omit (UC_SPARC_REG_INVALID,
UC_SPARC_REG_ENDING)
with prefix="UC_SPARC_REG_"
deriving (Show, Eq, Bounded) #}
{ underscoreToCase }
omit (UC_SPARC_REG_INVALID
, UC_SPARC_REG_ENDING
)
with prefix = "UC_SPARC_REG_"
deriving (Show, Eq, Bounded)
#}
instance Reg Register

49
bindings/haskell/src/Unicorn/CPU/X86.chs
View file

@ -8,11 +8,12 @@ License : GPL-2
Definitions for the X86 architecture.
-}
module Unicorn.CPU.X86 (
Mmr(..),
Register(..),
Instruction(..),
) where
module Unicorn.CPU.X86
(
Mmr(..)
, Register(..)
, Instruction(..)
) where
import Control.Applicative
import Data.Word
@ -20,18 +21,18 @@ import Foreign
import Unicorn.Internal.Core (Reg)
{# context lib="unicorn" #}
{# context lib = "unicorn" #}
#include <unicorn/x86.h>
-- | Memory-managemen Register for instructions IDTR, GDTR, LDTR, TR.
-- Borrow from SegmentCache in qemu/target-i386/cpu.h
data Mmr = Mmr {
mmrSelector :: Word16, -- ^ Not used by GDTR and IDTR
mmrBase :: Word64, -- ^ Handle 32 or 64 bit CPUs
mmrLimit :: Word32,
mmrFlags :: Word32 -- ^ Not used by GDTR and IDTR
}
data Mmr = Mmr
{ mmrSelector :: Word16 -- ^ Not used by GDTR and IDTR
, mmrBase :: Word64 -- ^ Handle 32 or 64 bit CPUs
, mmrLimit :: Word32
, mmrFlags :: Word32 -- ^ Not used by GDTR and IDTR
}
instance Storable Mmr where
sizeOf _ = {# sizeof uc_x86_mmr #}
@ -48,18 +49,22 @@ instance Storable Mmr where
-- | X86 registers.
{# enum uc_x86_reg as Register
{underscoreToCase}
omit (UC_X86_REG_INVALID,
UC_X86_REG_ENDING)
with prefix="UC_X86_REG_"
deriving (Show, Eq, Bounded) #}
{ underscoreToCase }
omit ( UC_X86_REG_INVALID
, UC_X86_REG_ENDING
)
with prefix = "UC_X86_REG_"
deriving (Show, Eq, Bounded)
#}
instance Reg Register
-- | X86 instructions.
{# enum uc_x86_insn as Instruction
{underscoreToCase}
omit (UC_X86_INS_INVALID,
UC_X86_INS_ENDING)
with prefix="UC_X86_INS_"
deriving (Show, Eq, Bounded) #}
{ underscoreToCase }
omit ( UC_X86_INS_INVALID
, UC_X86_INS_ENDING
)
with prefix = "UC_X86_INS_"
deriving (Show, Eq, Bounded)
#}

59
bindings/haskell/src/Unicorn/Hook.hs
View file

@ -6,36 +6,36 @@ License : GPL-2
Insert hook points into the Unicorn emulator engine.
-}
module Unicorn.Hook (
-- * Hook types
Hook,
MemoryHookType(..),
MemoryEventHookType(..),
MemoryAccess(..),
module Unicorn.Hook
( -- * Hook types
Hook
, MemoryHookType(..)
, MemoryEventHookType(..)
, MemoryAccess(..)
-- * Hook callbacks
CodeHook,
InterruptHook,
BlockHook,
InHook,
OutHook,
SyscallHook,
MemoryHook,
MemoryReadHook,
MemoryWriteHook,
MemoryEventHook,
-- * Hook callbacks
, CodeHook
, InterruptHook
, BlockHook
, InHook
, OutHook
, SyscallHook
, MemoryHook
, MemoryReadHook
, MemoryWriteHook
, MemoryEventHook
-- * Hook callback management
codeHookAdd,
interruptHookAdd,
blockHookAdd,
inHookAdd,
outHookAdd,
syscallHookAdd,
memoryHookAdd,
memoryEventHookAdd,
hookDel,
) where
-- * Hook callback management
, codeHookAdd
, interruptHookAdd
, blockHookAdd
, inHookAdd
, outHookAdd
, syscallHookAdd
, memoryHookAdd
, memoryEventHookAdd
, hookDel
) where
import Control.Monad
import Control.Monad.Trans.Class
@ -213,7 +213,8 @@ hookDel uc hook = do
-- Takes the tuple returned by `ucHookAdd`, an IO (Error, Hook), and
-- returns either a `Right Hook` if no error occurred or a `Left Error` if an
-- error occurred
getResult :: IO (Error, Hook) -> IO (Either Error Hook)
getResult :: IO (Error, Hook)
-> IO (Either Error Hook)
getResult =
liftM (uncurry checkResult)
where checkResult err hook =

17
bindings/haskell/src/Unicorn/Internal/Core.chs
View file

@ -17,31 +17,34 @@ import Control.Monad
import Control.Monad.Trans.Either (EitherT)
import Foreign
{# context lib="unicorn" #}
{# context lib = "unicorn" #}
#include <unicorn/unicorn.h>
#include "unicorn_wrapper.h"
-- | The Unicorn engine.
{# pointer *uc_engine as Engine
foreign finalizer uc_close_wrapper as close
newtype #}
foreign finalizer uc_close_wrapper as close
newtype
#}
-- | A pointer to a Unicorn engine.
{# pointer *uc_engine as EnginePtr -> Engine #}
-- | Make a new Unicorn engine out of an engine pointer. The returned Unicorn
-- engine will automatically call 'uc_close_wrapper' when it goes out of scope.
mkEngine :: EnginePtr -> IO Engine
mkEngine :: EnginePtr
-> IO Engine
mkEngine ptr =
liftM Engine (newForeignPtr close ptr)
-- | Errors encountered by the Unicorn API. These values are returned by
-- 'errno'.
{# enum uc_err as Error
{underscoreToCase}
with prefix="UC_"
deriving (Show, Eq, Bounded) #}
{ underscoreToCase }
with prefix = "UC_"
deriving (Show, Eq, Bounded)
#}
-- | The emulator runs in the IO monad and allows for the handling of errors
-- "under the hood".

280
bindings/haskell/src/Unicorn/Internal/Hook.chs
View file

@ -11,54 +11,54 @@ Low-level bindings for inserting hook points into the Unicorn emulator engine.
This module should not be directly imported; it is only exposed because of the
way cabal handles ordering of chs files.
-}
module Unicorn.Internal.Hook (
-- * Types
Hook,
HookType(..),
MemoryHookType(..),
MemoryEventHookType(..),
MemoryAccess(..),
module Unicorn.Internal.Hook
( -- * Types
Hook
, HookType(..)
, MemoryHookType(..)
, MemoryEventHookType(..)
, MemoryAccess(..)
-- * Hook callback bindings
CodeHook,
InterruptHook,
BlockHook,
InHook,
OutHook,
SyscallHook,
MemoryHook,
MemoryReadHook,
MemoryWriteHook,
MemoryEventHook,
-- * Hook callback bindings
, CodeHook
, InterruptHook
, BlockHook
, InHook
, OutHook
, SyscallHook
, MemoryHook
, MemoryReadHook
, MemoryWriteHook
, MemoryEventHook
-- * Hook marshalling
marshalCodeHook,
marshalInterruptHook,
marshalBlockHook,
marshalInHook,
marshalOutHook,
marshalSyscallHook,
marshalMemoryHook,
marshalMemoryReadHook,
marshalMemoryWriteHook,
marshalMemoryEventHook,
-- * Hook marshallin
, marshalCodeHook
, marshalInterruptHook
, marshalBlockHook
, marshalInHook
, marshalOutHook
, marshalSyscallHook
, marshalMemoryHook
, marshalMemoryReadHook
, marshalMemoryWriteHook
, marshalMemoryEventHook
-- * Hook registration and deletion bindings
ucHookAdd,
ucInsnHookAdd,
ucHookDel,
) where
-- * Hook registration and deletion bindings
, ucHookAdd
, ucInsnHookAdd
, ucHookDel
) where
import Control.Monad
import Foreign
import Unicorn.Internal.Util
{# context lib="unicorn" #}
{# import Unicorn.Internal.Core #}
{# import Unicorn.CPU.X86 #}
{# context lib = "unicorn" #}
#include <unicorn/unicorn.h>
#include "unicorn_wrapper.h"
@ -79,7 +79,8 @@ import Unicorn.Internal.Util
foreign import ccall "&uc_close_dummy"
closeDummy :: FunPtr (EnginePtr -> IO ())
mkEngineNC :: EnginePtr -> IO Engine
mkEngineNC :: EnginePtr
-> IO Engine
mkEngineNC ptr =
liftM Engine (newForeignPtr closeDummy ptr)
@ -92,47 +93,55 @@ type Hook = {# type uc_hook #}
-- Note that the both valid and invalid memory access hooks are omitted from
-- this enum (and are exposed to the user).
{# enum uc_hook_type as HookType
{underscoreToCase}
omit (UC_HOOK_MEM_READ_UNMAPPED,
UC_HOOK_MEM_WRITE_UNMAPPED,
UC_HOOK_MEM_FETCH_UNMAPPED,
UC_HOOK_MEM_READ_PROT,
UC_HOOK_MEM_WRITE_PROT,
UC_HOOK_MEM_FETCH_PROT,
UC_HOOK_MEM_READ,
UC_HOOK_MEM_WRITE,
UC_HOOK_MEM_FETCH)
with prefix="UC_"
deriving (Show, Eq, Bounded) #}
{ underscoreToCase }
omit ( UC_HOOK_MEM_READ_UNMAPPED
, UC_HOOK_MEM_WRITE_UNMAPPED
, UC_HOOK_MEM_FETCH_UNMAPPED
, UC_HOOK_MEM_READ_PROT
, UC_HOOK_MEM_WRITE_PROT
, UC_HOOK_MEM_FETCH_PROT
, UC_HOOK_MEM_READ
, UC_HOOK_MEM_WRITE
, UC_HOOK_MEM_FETCH
, UC_HOOK_MEM_READ_AFTER
)
with prefix = "UC_"
deriving (Show, Eq, Bounded)
#}
-- | Memory hook types (for valid memory accesses).
{# enum uc_hook_type as MemoryHookType
{underscoreToCase}
omit (UC_HOOK_INTR,
UC_HOOK_INSN,
UC_HOOK_CODE,
UC_HOOK_BLOCK,
UC_HOOK_MEM_READ_UNMAPPED,
UC_HOOK_MEM_WRITE_UNMAPPED,
UC_HOOK_MEM_FETCH_UNMAPPED,
UC_HOOK_MEM_READ_PROT,
UC_HOOK_MEM_WRITE_PROT,
UC_HOOK_MEM_FETCH_PROT)
with prefix="UC_"
deriving (Show, Eq, Bounded) #}
{ underscoreToCase }
omit ( UC_HOOK_INTR
, UC_HOOK_INSN
, UC_HOOK_CODE
, UC_HOOK_BLOCK
, UC_HOOK_MEM_READ_UNMAPPED
, UC_HOOK_MEM_WRITE_UNMAPPED
, UC_HOOK_MEM_FETCH_UNMAPPED
, UC_HOOK_MEM_READ_PROT
, UC_HOOK_MEM_WRITE_PROT
, UC_HOOK_MEM_FETCH_PROT
)
with prefix = "UC_"
deriving (Show, Eq, Bounded)
#}
-- | Memory event hook types (for invalid memory accesses).
{# enum uc_hook_type as MemoryEventHookType
{underscoreToCase}
omit (UC_HOOK_INTR,
UC_HOOK_INSN,
UC_HOOK_CODE,
UC_HOOK_BLOCK,
UC_HOOK_MEM_READ,
UC_HOOK_MEM_WRITE,
UC_HOOK_MEM_FETCH)
with prefix="UC_"
deriving (Show, Eq, Bounded) #}
{ underscoreToCase }
omit ( UC_HOOK_INTR
, UC_HOOK_INSN
, UC_HOOK_CODE
, UC_HOOK_BLOCK
, UC_HOOK_MEM_READ
, UC_HOOK_MEM_WRITE
, UC_HOOK_MEM_FETCH
, UC_HOOK_MEM_READ_AFTER
)
with prefix = "UC_"
deriving (Show, Eq, Bounded)
#}
-- | Unify the hook types with a type class
class Enum a => HookTypeC a
@ -143,9 +152,10 @@ instance HookTypeC MemoryEventHookType
-- | Memory access.
{# enum uc_mem_type as MemoryAccess
{underscoreToCase}
with prefix="UC_"
deriving (Show, Eq, Bounded) #}
{ underscoreToCase }
with prefix = "UC_"
deriving (Show, Eq, Bounded)
#}
-------------------------------------------------------------------------------
-- Hook callbacks
@ -159,16 +169,18 @@ type CodeHook a = Engine -- ^ 'Unicorn' engine handle
-> a -- ^ User data passed to tracing APIs
-> IO ()
type CCodeHook = EnginePtr -> Word64 -> Word32 -> Ptr () -> IO ()
type CCodeHook = EnginePtr -> Word64 -> Word32 -> Ptr () -> IO ()
foreign import ccall "wrapper"
mkCodeHook :: CCodeHook -> IO {# type uc_cb_hookcode_t #}
mkCodeHook :: CCodeHook
-> IO {# type uc_cb_hookcode_t #}
marshalCodeHook :: Storable a
=> CodeHook a -> IO {# type uc_cb_hookcode_t #}
=> CodeHook a
-> IO {# type uc_cb_hookcode_t #}
marshalCodeHook codeHook =
mkCodeHook $ \ucPtr address size userDataPtr -> do
uc <- mkEngineNC ucPtr
uc <- mkEngineNC ucPtr
userData <- castPtrAndPeek userDataPtr
let maybeSize = if size == 0 then Nothing
else Just $ fromIntegral size
@ -186,10 +198,11 @@ foreign import ccall "wrapper"
mkInterruptHook :: CInterruptHook -> IO {# type uc_cb_hookintr_t #}
marshalInterruptHook :: Storable a
=> InterruptHook a -> IO {# type uc_cb_hookintr_t #}
=> InterruptHook a
-> IO {# type uc_cb_hookintr_t #}
marshalInterruptHook interruptHook =
mkInterruptHook $ \ucPtr intNo userDataPtr -> do
uc <- mkEngineNC ucPtr
uc <- mkEngineNC ucPtr
userData <- castPtrAndPeek userDataPtr
interruptHook uc (fromIntegral intNo) userData
@ -197,7 +210,8 @@ marshalInterruptHook interruptHook =
type BlockHook a = CodeHook a
marshalBlockHook :: Storable a
=> BlockHook a -> IO {# type uc_cb_hookcode_t #}
=> BlockHook a
-> IO {# type uc_cb_hookcode_t #}
marshalBlockHook =
marshalCodeHook
@ -214,10 +228,11 @@ foreign import ccall "wrapper"
mkInHook :: CInHook -> IO {# type uc_cb_insn_in_t #}
marshalInHook :: Storable a
=> InHook a -> IO {# type uc_cb_insn_in_t #}
=> InHook a
-> IO {# type uc_cb_insn_in_t #}
marshalInHook inHook =
mkInHook $ \ucPtr port size userDataPtr -> do
uc <- mkEngineNC ucPtr
uc <- mkEngineNC ucPtr
userData <- castPtrAndPeek userDataPtr
inHook uc (fromIntegral port) (fromIntegral size) userData
@ -232,13 +247,15 @@ type OutHook a = Engine -- ^ 'Unicorn' engine handle
type COutHook = EnginePtr -> Word32 -> Int32 -> Word32 -> Ptr () -> IO ()
foreign import ccall "wrapper"
mkOutHook :: COutHook -> IO {# type uc_cb_insn_out_t #}
mkOutHook :: COutHook
-> IO {# type uc_cb_insn_out_t #}
marshalOutHook :: Storable a
=> OutHook a -> IO {# type uc_cb_insn_out_t #}
=> OutHook a
-> IO {# type uc_cb_insn_out_t #}
marshalOutHook outHook =
mkOutHook $ \ucPtr port size value userDataPtr -> do
uc <- mkEngineNC ucPtr
uc <- mkEngineNC ucPtr
userData <- castPtrAndPeek userDataPtr
outHook uc (fromIntegral port) (fromIntegral size) (fromIntegral value)
userData
@ -251,13 +268,15 @@ type SyscallHook a = Engine -- ^ 'Unicorn' engine handle
type CSyscallHook = Ptr () -> Ptr () -> IO ()
foreign import ccall "wrapper"
mkSyscallHook :: CSyscallHook -> IO {# type uc_cb_insn_syscall_t #}
mkSyscallHook :: CSyscallHook
-> IO {# type uc_cb_insn_syscall_t #}
marshalSyscallHook :: Storable a
=> SyscallHook a -> IO {# type uc_cb_insn_syscall_t #}
=> SyscallHook a
-> IO {# type uc_cb_insn_syscall_t #}
marshalSyscallHook syscallHook =
mkSyscallHook $ \ucPtr userDataPtr -> do
uc <- mkEngineNC $ castPtr ucPtr
uc <- mkEngineNC $ castPtr ucPtr
userData <- castPtrAndPeek userDataPtr
syscallHook uc userData
@ -281,13 +300,15 @@ type CMemoryHook = EnginePtr
-> IO ()
foreign import ccall "wrapper"
mkMemoryHook :: CMemoryHook -> IO {# type uc_cb_hookmem_t #}
mkMemoryHook :: CMemoryHook
-> IO {# type uc_cb_hookmem_t #}
marshalMemoryHook :: Storable a
=> MemoryHook a -> IO {# type uc_cb_hookmem_t #}
=> MemoryHook a
-> IO {# type uc_cb_hookmem_t #}
marshalMemoryHook memoryHook =
mkMemoryHook $ \ucPtr memAccessI address size value userDataPtr -> do
uc <- mkEngineNC ucPtr
uc <- mkEngineNC ucPtr
userData <- castPtrAndPeek userDataPtr
let memAccess = toMemAccess memAccessI
maybeValue = case memAccess of
@ -304,10 +325,11 @@ type MemoryReadHook a = Engine -- ^ 'Unicorn' engine handle
-> IO ()
marshalMemoryReadHook :: Storable a
=> MemoryReadHook a -> IO {# type uc_cb_hookmem_t #}
=> MemoryReadHook a
-> IO {# type uc_cb_hookmem_t #}
marshalMemoryReadHook memoryReadHook =
mkMemoryHook $ \ucPtr _ address size _ userDataPtr -> do
uc <- mkEngineNC ucPtr
uc <- mkEngineNC ucPtr
userData <- castPtrAndPeek userDataPtr
memoryReadHook uc address (fromIntegral size) userData
@ -321,10 +343,11 @@ type MemoryWriteHook a = Engine -- ^ 'Unicorn' engine handle
-> IO ()
marshalMemoryWriteHook :: Storable a
=> MemoryWriteHook a -> IO {# type uc_cb_hookmem_t #}
=> MemoryWriteHook a
-> IO {# type uc_cb_hookmem_t #}
marshalMemoryWriteHook memoryWriteHook =
mkMemoryHook $ \ucPtr _ address size value userDataPtr -> do
uc <- mkEngineNC ucPtr
uc <- mkEngineNC ucPtr
userData <- castPtrAndPeek userDataPtr
memoryWriteHook uc address (fromIntegral size) (fromIntegral value)
userData
@ -351,15 +374,17 @@ type CMemoryEventHook = EnginePtr
-> IO Int32
foreign import ccall "wrapper"
mkMemoryEventHook :: CMemoryEventHook -> IO {# type uc_cb_eventmem_t #}
mkMemoryEventHook :: CMemoryEventHook
-> IO {# type uc_cb_eventmem_t #}
marshalMemoryEventHook :: Storable a
=> MemoryEventHook a -> IO {# type uc_cb_eventmem_t #}
=> MemoryEventHook a
-> IO {# type uc_cb_eventmem_t #}
marshalMemoryEventHook eventMemoryHook =
mkMemoryEventHook $ \ucPtr memAccessI address size value userDataPtr -> do
uc <- mkEngineNC ucPtr
uc <- mkEngineNC ucPtr
userData <- castPtrAndPeek userDataPtr
let memAccess = toMemAccess memAccessI
let memAccess = toMemAccess memAccessI
maybeValue = case memAccess of
MemReadUnmapped -> Nothing
MemReadProt -> Nothing
@ -369,7 +394,7 @@ marshalMemoryEventHook eventMemoryHook =
res <- eventMemoryHook uc memAccess address (fromIntegral size)
maybeValue userData
return $ boolToInt res
where boolToInt True = 1
where boolToInt True = 1
boolToInt False = 0
@ -378,38 +403,43 @@ marshalMemoryEventHook eventMemoryHook =
-------------------------------------------------------------------------------
{# fun variadic uc_hook_add as ucHookAdd
`(Storable a, HookTypeC h)' =>
{`Engine',
alloca- `Hook' peek*,
enumToNum `h',
castFunPtrToPtr `FunPtr b',
castPtr `Ptr a',
`Word64',
`Word64'}
-> `Error' #}
`HookTypeC h' =>
{ `Engine'
, alloca- `Hook' peek*
, enumToNum `h'
, castFunPtrToPtr `FunPtr b'
, castPtr `Ptr a'
, `Word64'
, `Word64'
} -> `Error'
#}
{# fun variadic uc_hook_add[int] as ucInsnHookAdd
`(Storable a, HookTypeC h)' =>
{`Engine',
alloca- `Hook' peek*,
enumToNum `h',
castFunPtrToPtr `FunPtr b',
castPtr `Ptr a',
`Word64',
`Word64',
enumToNum `Instruction'}
-> `Error' #}
`HookTypeC h' =>
{ `Engine'
, alloca- `Hook' peek*
, enumToNum `h'
, castFunPtrToPtr `FunPtr b'
, castPtr `Ptr a'
, `Word64'
, `Word64'
, enumToNum `Instruction'
} -> `Error'
#}
-- | Unregister (remove) a hook callback.
{# fun uc_hook_del as ^
{`Engine',
fromIntegral `Hook'}
-> `Error' #}
{ `Engine'
, fromIntegral `Hook'
} -> `Error'
#}
-------------------------------------------------------------------------------
-- Helper functions
-------------------------------------------------------------------------------
toMemAccess :: Integral a => a -> MemoryAccess
toMemAccess :: Integral a
=> a
-> MemoryAccess
toMemAccess =
toEnum . fromIntegral

279
bindings/haskell/src/Unicorn/Internal/Unicorn.chs
View file

@ -12,33 +12,39 @@ Low-level bindings for the Unicorn CPU emulator framework.
This module should not be directly imported; it is only exposed because of the
way cabal handles ordering of chs files.
-}
module Unicorn.Internal.Unicorn (
-- * Types
Architecture(..),
Mode(..),
MemoryPermission(..),
MemoryRegion(..),
QueryType(..),
module Unicorn.Internal.Unicorn
( -- * Types
Architecture(..)
, Mode(..)
, MemoryPermission(..)
, MemoryRegion(..)
, QueryType(..)
, Context
-- * Function bindings
ucOpen,
ucQuery,
ucEmuStart,
ucEmuStop,
ucRegWrite,
ucRegRead,
ucMemWrite,
ucMemRead,
ucMemMap,
ucMemUnmap,
ucMemProtect,
ucMemRegions,
ucVersion,
ucErrno,
ucStrerror,
) where
-- * Function bindings
, ucOpen
, ucQuery
, ucEmuStart
, ucEmuStop
, ucRegWrite
, ucRegRead
, ucMemWrite
, ucMemRead
, ucMemMap
, ucMemUnmap
, ucMemProtect
, ucMemRegions
, mkContext
, ucContextAlloc
, ucContextSave
, ucContextRestore
, ucVersion
, ucErrno
, ucStrerror
) where
import Control.Applicative
import Control.Monad
import Data.ByteString (ByteString, useAsCStringLen)
import Foreign
import Foreign.C
@ -46,11 +52,12 @@ import Prelude hiding (until)
import Unicorn.Internal.Util
{# context lib="unicorn" #}
{# import Unicorn.Internal.Core #}
{# context lib = "unicorn" #}
#include <unicorn/unicorn.h>
#include "unicorn_wrapper.h"
-------------------------------------------------------------------------------
-- Types
@ -58,29 +65,33 @@ import Unicorn.Internal.Util
-- | CPU architecture.
{# enum uc_arch as Architecture
{underscoreToCase}
with prefix="UC_"
deriving (Show, Eq, Bounded) #}
{ underscoreToCase }
with prefix = "UC_"
deriving (Show, Eq, Bounded)
#}
-- | CPU hardware mode.
{# enum uc_mode as Mode
{underscoreToCase}
with prefix="UC_"
deriving (Show, Eq, Bounded) #}
{ underscoreToCase }
with prefix = "UC_"
deriving (Show, Eq, Bounded)
#}
-- | Memory permissions.
{# enum uc_prot as MemoryPermission
{underscoreToCase}
with prefix="UC_"
deriving (Show, Eq, Bounded) #}
{ underscoreToCase }
with prefix = "UC_"
deriving (Show, Eq, Bounded)
#}
-- | Memory region mapped by 'memMap'. Retrieve the list of memory regions with
-- 'memRegions'.
data MemoryRegion = MemoryRegion {
mrBegin :: Word64, -- ^ Begin address of the region (inclusive)
mrEnd :: Word64, -- ^ End address of the region (inclusive)
mrPerms :: [MemoryPermission] -- ^ Memory permissions of the region
}
data MemoryRegion = MemoryRegion
{
mrBegin :: Word64 -- ^ Begin address of the region (inclusive)
, mrEnd :: Word64 -- ^ End address of the region (inclusive)
, mrPerms :: [MemoryPermission] -- ^ Memory permissions of the region
}
instance Storable MemoryRegion where
sizeOf _ = {# sizeof uc_mem_region #}
@ -99,121 +110,174 @@ instance Storable MemoryRegion where
-- | Query types for the 'query' API.
{# enum uc_query_type as QueryType
{underscoreToCase}
with prefix="UC_"
deriving (Show, Eq, Bounded) #}
{ underscoreToCase }
with prefix = "UC_"
deriving (Show, Eq, Bounded)
#}
-- | Opaque storage for CPU context, used with the context functions.
{# pointer *uc_context as Context
foreign finalizer uc_context_free_wrapper as contextFree
newtype
#}
-- | A pointer to a CPU context.
{# pointer *uc_context as ContextPtr -> Context #}
-- | Make a CPU context out of a context pointer. The returned CPU context will
-- automatically call 'uc_context_free' when it goes out of scope.
mkContext :: ContextPtr
-> IO Context
mkContext ptr =
liftM Context (newForeignPtr contextFree ptr)
-------------------------------------------------------------------------------
-- Emulator control
-------------------------------------------------------------------------------
{# fun uc_open as ^
{`Architecture',
combineEnums `[Mode]',
alloca- `EnginePtr' peek*}
-> `Error' #}
{ `Architecture'
, combineEnums `[Mode]'
, alloca- `EnginePtr' peek*
} -> `Error'
#}
{# fun uc_query as ^
{`Engine',
`QueryType',
alloca- `Int' castPtrAndPeek*}
-> `Error' #}
{ `Engine'
, `QueryType'
, alloca- `Int' castPtrAndPeek*
} -> `Error'
#}
{# fun uc_emu_start as ^
{`Engine',
`Word64',
`Word64',
`Int',
`Int'}
-> `Error' #}
{ `Engine'
, `Word64'
, `Word64'
, `Int'
, `Int'} -> `Error'
#}
{# fun uc_emu_stop as ^
{`Engine'}
-> `Error' #}
{ `Engine'
} -> `Error'
#}
-------------------------------------------------------------------------------
-- Register operations
-------------------------------------------------------------------------------
{# fun uc_reg_write as ^
`Reg r' =>
{`Engine',
enumToNum `r',
castPtr `Ptr Int64'}
-> `Error' #}
`Reg r' =>
{ `Engine'
, enumToNum `r'
, castPtr `Ptr Int64'
} -> `Error'
#}
{# fun uc_reg_read as ^
`Reg r' =>
{`Engine',
enumToNum `r',
allocaInt64ToVoid- `Int64' castPtrAndPeek*}
-> `Error' #}
`Reg r' =>
{ `Engine'
, enumToNum `r'
, allocaInt64ToVoid- `Int64' castPtrAndPeek*
} -> `Error'
#}
-------------------------------------------------------------------------------
-- Memory operations
-------------------------------------------------------------------------------
{# fun uc_mem_write as ^
{`Engine',
`Word64',
withByteStringLen* `ByteString'&}
-> `Error' #}
{ `Engine'
, `Word64'
, withByteStringLen* `ByteString'&
} -> `Error'
#}
{# fun uc_mem_read as ^
{`Engine',
`Word64',
castPtr `Ptr Word8',
`Int'}
-> `Error' #}
{ `Engine'
, `Word64'
, castPtr `Ptr Word8'
, `Int'} -> `Error'
#}
{# fun uc_mem_map as ^
{`Engine',
`Word64',
`Int',
combineEnums `[MemoryPermission]'}
-> `Error' #}
{ `Engine'
, `Word64'
, `Int'
, combineEnums `[MemoryPermission]'
} -> `Error' #}
{# fun uc_mem_unmap as ^
{`Engine',
`Word64',
`Int'}
-> `Error' #}
{ `Engine'
, `Word64'
, `Int'
} -> `Error'
#}
{# fun uc_mem_protect as ^
{`Engine',
`Word64',
`Int',
combineEnums `[MemoryPermission]'}
-> `Error' #}
{ `Engine'
, `Word64'
, `Int'
, combineEnums `[MemoryPermission]'
} -> `Error'
#}
{# fun uc_mem_regions as ^
{`Engine',
alloca- `MemoryRegionPtr' peek*,
alloca- `Int' castPtrAndPeek*}
-> `Error' #}
{ `Engine'
, alloca- `MemoryRegionPtr' peek*
, alloca- `Int' castPtrAndPeek*
} -> `Error'
#}
-------------------------------------------------------------------------------
-- Context
-------------------------------------------------------------------------------
{# fun uc_context_alloc as ^
{ `Engine'
, alloca- `ContextPtr' peek*
} -> `Error'
#}
{# fun uc_context_save as ^
{ `Engine'
, `Context'
} -> `Error'
#}
{# fun uc_context_restore as ^
{ `Engine'
, `Context'
} -> `Error'
#}
-------------------------------------------------------------------------------
-- Misc.
-------------------------------------------------------------------------------
{# fun pure unsafe uc_version as ^
{id `Ptr CUInt',
id `Ptr CUInt'}
-> `Int' #}
{ id `Ptr CUInt'
, id `Ptr CUInt'
} -> `Int'
#}
{# fun unsafe uc_errno as ^
{`Engine'}
-> `Error' #}
{ `Engine'
} -> `Error'
#}
{# fun pure unsafe uc_strerror as ^
{`Error'}
-> `String' #}
{ `Error'
} -> `String'
#}
-------------------------------------------------------------------------------
-- Helper functions
-------------------------------------------------------------------------------
expandMemPerms :: (Integral a, Bits a) => a -> [MemoryPermission]
expandMemPerms :: (Integral a, Bits a)
=> a
-> [MemoryPermission]
expandMemPerms perms =
-- Only interested in the 3 least-significant bits
let maskedPerms = fromIntegral $ perms .&. 0x7 in
@ -232,10 +296,13 @@ expandMemPerms perms =
checkRWE _ [] =
[]
allocaInt64ToVoid :: (Ptr () -> IO b) -> IO b
allocaInt64ToVoid :: (Ptr () -> IO b)
-> IO b
allocaInt64ToVoid f =
alloca $ \(ptr :: Ptr Int64) -> poke ptr 0 >> f (castPtr ptr)
withByteStringLen :: ByteString -> ((Ptr (), CULong) -> IO a) -> IO a
withByteStringLen :: ByteString
-> ((Ptr (), CULong) -> IO a)
-> IO a
withByteStringLen bs f =
useAsCStringLen bs $ \(ptr, len) -> f (castPtr ptr, fromIntegral len)

12
bindings/haskell/src/Unicorn/Internal/Util.hs
View file

@ -10,16 +10,22 @@ import Data.Bits
import Foreign
-- | Combine a list of Enums by performing a bitwise-OR.
combineEnums :: (Enum a, Num b, Bits b) => [a] -> b
combineEnums :: (Enum a, Num b, Bits b)
=> [a]
-> b
combineEnums =
foldr ((.|.) <$> enumToNum) 0
-- | Cast a pointer and then peek inside it.
castPtrAndPeek :: Storable a => Ptr b -> IO a
castPtrAndPeek :: Storable a
=> Ptr b
-> IO a
castPtrAndPeek =
peek . castPtr
-- | Convert an 'Eum' to a 'Num'.
enumToNum :: (Enum a, Num b) => a -> b
enumToNum :: (Enum a, Num b)
=> a
-> b
enumToNum =
fromIntegral . fromEnum

4
bindings/haskell/src/cbits/unicorn_wrapper.c
View file

@ -6,3 +6,7 @@ void uc_close_wrapper(uc_engine *uc) {
void uc_close_dummy(uc_engine *uc) {
}
void uc_context_free_wrapper(uc_context *context) {
uc_context_free(context);
}

5
bindings/haskell/src/include/unicorn_wrapper.h
View file

@ -13,4 +13,9 @@ void uc_close_wrapper(uc_engine *uc);
*/
void uc_close_dummy(uc_engine *uc);
/*
* Wrap Unicorn's uc_context_free function and ignore the returned error code.
*/
void uc_context_free_wrapper(uc_context *context);
#endif

13
bindings/haskell/unicorn.cabal
View file

@ -13,8 +13,9 @@ copyright: (c) 2016, Adrian Herrera
category: System
build-type: Simple
stability: experimental
cabal-version: >=1.10
extra-source-files: cbits/, include/
cabal-version: >= 1.10
extra-source-files: cbits/
, include/
library
exposed-modules: Unicorn.Internal.Core
@ -29,10 +30,10 @@ library
Unicorn.Hook
Unicorn
other-modules: Unicorn.Internal.Util
build-depends: base >=4 && <5,
bytestring >= 0.9.1,
transformers < 0.6,
either >= 4.4
build-depends: base >=4 && <5
, bytestring >= 0.9.1
, transformers < 0.6
, either >= 4.4
hs-source-dirs: src
c-sources: src/cbits/unicorn_wrapper.c
include-dirs: src/include