From 6df5a6508593044d29383461b147101ee9e066a2 Mon Sep 17 00:00:00 2001 From: nganhkhoa Date: Sat, 2 May 2020 04:03:13 +0700 Subject: [PATCH 01/21] update old arch to capstone v4 --- src/Hapstone/Internal/Arm.chs | 97 ++++++++------- src/Hapstone/Internal/Arm64.chs | 84 +++++++------ src/Hapstone/Internal/Capstone.chs | 17 ++- src/Hapstone/Internal/Mips.chs | 38 +++--- src/Hapstone/Internal/Ppc.chs | 42 ++++--- src/Hapstone/Internal/Sparc.chs | 30 ++--- src/Hapstone/Internal/SystemZ.chs | 28 +++-- src/Hapstone/Internal/X86.chs | 189 +++++++++++++++++++++++------ src/Hapstone/Internal/XCore.chs | 26 ++-- stack.yaml | 6 +- 10 files changed, 360 insertions(+), 197 deletions(-) diff --git a/src/Hapstone/Internal/Arm.chs b/src/Hapstone/Internal/Arm.chs index 0f021a9..b8588ae 100644 --- a/src/Hapstone/Internal/Arm.chs +++ b/src/Hapstone/Internal/Arm.chs @@ -24,9 +24,12 @@ module Hapstone.Internal.Arm where {#context lib = "capstone"#} +import Data.Maybe (fromMaybe) import Foreign import Foreign.C.Types +import Hapstone.Internal.Util + -- | ARM shift type {#enum arm_shifter as ArmShifter {underscoreToCase} deriving (Show, Eq, Bounded)#} @@ -68,6 +71,7 @@ data ArmOpMemStruct = ArmOpMemStruct , index :: ArmReg -- ^ index register , scale :: Int32 -- ^ scale for index register (1 or -1) , disp :: Int32 -- ^ displacement/offset value + , lshift :: Maybe Int32 -- ^ left shift } deriving (Show, Eq) instance Storable ArmOpMemStruct where @@ -78,19 +82,21 @@ instance Storable ArmOpMemStruct where <*> ((toEnum . fromIntegral) <$> {#get arm_op_mem->index#} p) <*> (fromIntegral <$> {#get arm_op_mem->scale#} p) <*> (fromIntegral <$> {#get arm_op_mem->disp#} p) - poke p (ArmOpMemStruct b i s d) = do + <*> (fromZero . fromIntegral <$> {#get arm_op_mem->lshift#} p) + poke p (ArmOpMemStruct b i s d l) = do {#set arm_op_mem->base#} p (fromIntegral $ fromEnum b) {#set arm_op_mem->index#} p (fromIntegral $ fromEnum i) {#set arm_op_mem->scale#} p (fromIntegral s) {#set arm_op_mem->disp#} p (fromIntegral d) + {#set arm_op_mem->lshift#} p (fromIntegral $ fromMaybe 0 l) -- | possible operand types (corresponding to the tagged union in the C header) data CsArmOpValue - = Reg Word32 -- ^ register value for 'ArmOpReg' operands - | Sysreg Word32 -- ^ register value for 'ArmOpSysreg' operands + = Reg Int32 -- ^ register value for 'ArmOpReg' operands + | Sysreg Int32 -- ^ register value for 'ArmOpSysreg' operands | Imm Int32 -- ^ immediate value for 'ArmOpImm' operands - | Cimm Int32 -- ^ immediate value for 'ArmOpCimm' operands - | Pimm Int32 -- ^ immediate value for 'ArmOpPimm' operands + | CImm Int32 -- ^ immediate value for 'ArmOpCimm' operands + | PImm Int32 -- ^ immediate value for 'ArmOpPimm' operands | Fp Double -- ^ floating point value for 'ArmOpFp' operands | Mem ArmOpMemStruct -- ^ base,index,scale,disp value for -- 'ArmOpMem' operands @@ -109,8 +115,8 @@ data CsArmOp = CsArmOp } deriving (Show, Eq) instance Storable CsArmOp where - sizeOf _ = 40 - alignment _ = 8 + sizeOf _ = {#sizeof cs_arm_op#} + alignment _ = {#alignof cs_arm_op#} peek p = CsArmOp <$> (fromIntegral <$> {#get cs_arm_op->vector_index#} p) <*> ((,) <$> @@ -118,56 +124,59 @@ instance Storable CsArmOp where (fromIntegral <$> {#get cs_arm_op->shift.value#} p)) <*> do t <- fromIntegral <$> {#get cs_arm_op->type#} p :: IO Int - let bP = plusPtr p 16 + let memP = plusPtr p {#offsetof cs_arm_op->mem#} case toEnum t of - ArmOpReg -> (Reg . fromIntegral) <$> (peek bP :: IO CUInt) - ArmOpSysreg -> (Sysreg . fromIntegral) <$> (peek bP :: IO CUInt) - ArmOpImm -> (Imm . fromIntegral) <$> (peek bP :: IO CInt) - ArmOpCimm -> (Cimm . fromIntegral) <$> (peek bP :: IO CInt) - ArmOpPimm -> (Pimm . fromIntegral) <$> (peek bP :: IO CInt) - ArmOpFp -> (Fp . realToFrac) <$> (peek bP :: IO CDouble) - ArmOpMem -> Mem <$> (peek bP :: IO ArmOpMemStruct) - ArmOpSetend -> (Setend . toEnum . fromIntegral) <$> - (peek bP :: IO CInt) + ArmOpReg -> (Reg . fromIntegral) <$> {#get cs_arm_op->reg#} p + ArmOpSysreg -> (Sysreg . fromIntegral) <$> {#get cs_arm_op->reg#} p + ArmOpImm -> (Imm . fromIntegral) <$> {#get cs_arm_op->imm#} p + ArmOpCimm -> (CImm . fromIntegral) <$> {#get cs_arm_op->imm#} p + ArmOpPimm -> (PImm . fromIntegral) <$> {#get cs_arm_op->imm#} p + ArmOpFp -> (Fp . realToFrac) <$> {#get cs_arm_op->fp#} p + ArmOpMem -> Mem <$> (peek memP) + ArmOpSetend -> (Setend . toEnum . fromIntegral) <$> {#get cs_arm_op->setend#} p _ -> return Undefined - <*> (toBool <$> (peekByteOff p 36 :: IO Word8)) -- subtracted - <*> (peekByteOff p 37 :: IO Word8) -- access - <*> (peekByteOff p 38 :: IO Int8) -- neon_lane + <*> ({#get cs_arm_op->subtracted#} p) + <*> (fromIntegral <$> {#get cs_arm_op->access#} p) + <*> (fromIntegral <$> {#get cs_arm_op->neon_lane#} p) poke p (CsArmOp vI (sh, shV) val sub acc neon) = do {#set cs_arm_op->vector_index#} p (fromIntegral vI) {#set cs_arm_op->shift.type#} p (fromIntegral $ fromEnum sh) {#set cs_arm_op->shift.value#} p (fromIntegral shV) - let bP = plusPtr p 16 + let regP = plusPtr p {#offsetof cs_arm_op->reg#} + immP = plusPtr p {#offsetof cs_arm_op->imm#} + fpP = plusPtr p {#offsetof cs_arm_op->fp#} + memP = plusPtr p {#offsetof cs_arm_op->mem#} + setendP = plusPtr p {#offsetof cs_arm_op->setend#} setType = {#set cs_arm_op->type#} p . fromIntegral . fromEnum case val of Reg r -> do - poke bP (fromIntegral r :: CUInt) + poke regP (fromIntegral r :: CUInt) setType ArmOpReg Sysreg r -> do - poke bP (fromIntegral r :: CUInt) + poke regP (fromIntegral r :: CUInt) setType ArmOpSysreg Imm i -> do - poke bP (fromIntegral i :: CInt) + poke immP (fromIntegral i :: CInt) setType ArmOpImm - Cimm i -> do - poke bP (fromIntegral i :: CInt) + CImm i -> do + poke immP (fromIntegral i :: CInt) setType ArmOpCimm - Pimm i -> do - poke bP (fromIntegral i :: CInt) + PImm i -> do + poke immP (fromIntegral i :: CInt) setType ArmOpPimm Fp f -> do - poke bP (realToFrac f :: CDouble) + poke fpP (realToFrac f :: CDouble) setType ArmOpFp Mem m -> do - poke bP m + poke memP m setType ArmOpMem Setend s -> do - poke bP (fromIntegral $ fromEnum s :: CInt) + poke setendP (fromIntegral $ fromEnum s :: CInt) setType ArmOpSetend _ -> setType ArmOpInvalid - pokeByteOff p 36 (fromBool sub :: Word8) -- subtracted - pokeByteOff p 37 acc -- access - pokeByteOff p 38 neon -- neon_lane + {#set cs_arm_op->subtracted#} p sub + {#set cs_arm_op->access#} p $ fromIntegral acc + {#set cs_arm_op->neon_lane#} p $ fromIntegral neon -- | instruction datatype data CsArm = CsArm @@ -190,35 +199,35 @@ data CsArm = CsArm } deriving (Show, Eq) instance Storable CsArm where - sizeOf _ = 1480 - alignment _ = 8 + sizeOf _ = {#sizeof cs_arm#} + alignment _ = {#alignof cs_arm#} peek p = CsArm - <$> (toBool <$> (peekByteOff p 0 :: IO Word8)) -- usermode + <$> ({#get cs_arm->usermode#} p) <*> (fromIntegral <$> {#get cs_arm->vector_size#} p) <*> ((toEnum . fromIntegral) <$> {#get cs_arm->vector_data#} p) <*> ((toEnum . fromIntegral) <$> {#get cs_arm->cps_mode#} p) <*> ((toEnum . fromIntegral) <$> {#get cs_arm->cps_flag#} p) <*> ((toEnum . fromIntegral) <$> {#get cs_arm->cc#} p) - <*> (toBool <$> (peekByteOff p 24 :: IO Word8)) -- update_flags - <*> (toBool <$> (peekByteOff p 25 :: IO Word8)) -- writeback + <*> ({#get cs_arm->update_flags#} p) + <*> ({#get cs_arm->writeback#} p) <*> ((toEnum . fromIntegral) <$> {#get cs_arm->mem_barrier#} p) <*> do num <- fromIntegral <$> {#get cs_arm->op_count#} p - let ptr = plusPtr p 40 + let ptr = plusPtr p {#offsetof cs_arm->operands#} peekArray num ptr poke p (CsArm u vS vD cM cF cc uF w m o) = do - pokeByteOff p 0 (fromBool u :: Word8) -- usermode + {#set cs_arm->usermode#} p u {#set cs_arm->vector_size#} p (fromIntegral vS) {#set cs_arm->vector_data#} p (fromIntegral $ fromEnum vD) {#set cs_arm->cps_mode#} p (fromIntegral $ fromEnum cM) {#set cs_arm->cps_flag#} p (fromIntegral $ fromEnum cF) {#set cs_arm->cc#} p (fromIntegral $ fromEnum cc) - pokeByteOff p 24 (fromBool uF :: Word8) -- update_flags - pokeByteOff p 25 (fromBool w :: Word8) -- writeback + {#set cs_arm->update_flags#} p uF + {#set cs_arm->writeback#} p w {#set cs_arm->mem_barrier#} p (fromIntegral $ fromEnum m) {#set cs_arm->op_count#} p (fromIntegral $ length o) if length o > 36 then error "operands overflew 36 elements" - else pokeArray (plusPtr p 40) o + else pokeArray (plusPtr p {#offsetof cs_arm->operands#}) o -- | ARM instructions {#enum arm_insn as ArmInsn {underscoreToCase} diff --git a/src/Hapstone/Internal/Arm64.chs b/src/Hapstone/Internal/Arm64.chs index 419c772..5faca6c 100644 --- a/src/Hapstone/Internal/Arm64.chs +++ b/src/Hapstone/Internal/Arm64.chs @@ -98,11 +98,11 @@ instance Storable Arm64OpMemStruct where peek p = Arm64OpMemStruct <$> ((toEnum . fromIntegral) <$> {#get arm64_op_mem->base#} p) <*> ((toEnum . fromIntegral) <$> {#get arm64_op_mem->index#} p) - <*> ((toEnum . fromIntegral) <$> {#get arm64_op_mem->disp#} p) + <*> (fromIntegral <$> {#get arm64_op_mem->disp#} p) poke p (Arm64OpMemStruct b i d) = do {#set arm64_op_mem->base#} p (fromIntegral $ fromEnum b) {#set arm64_op_mem->index#} p (fromIntegral $ fromEnum i) - {#set arm64_op_mem->disp#} p (fromIntegral $ fromEnum d) + {#set arm64_op_mem->disp#} p (fromIntegral d) -- | possible operand types (corresponding to the tagged union in the C header) data CsArm64OpValue @@ -133,35 +133,34 @@ data CsArm64Op = CsArm64Op } deriving (Show, Eq) instance Storable CsArm64Op where - sizeOf _ = 48 - alignment _ = 8 + sizeOf _ = {#sizeof cs_arm64_op#} + alignment _ = {#alignof cs_arm64_op#} peek p = CsArm64Op <$> (fromIntegral <$> {#get cs_arm64_op->vector_index#} p) <*> ((toEnum . fromIntegral) <$> {#get cs_arm64_op->vas#} p) <*> ((toEnum . fromIntegral) <$> {#get cs_arm64_op->vess#} p) - <*> ((,) <$> - ((toEnum . fromIntegral) <$> {#get cs_arm64_op->shift.type#} p) <*> - (fromIntegral <$> {#get cs_arm64_op->shift.value#} p)) + <*> ((,) + <$> ((toEnum . fromIntegral) <$> {#get cs_arm64_op->shift.type#} p) + <*> (fromIntegral <$> {#get cs_arm64_op->shift.value#} p)) <*> ((toEnum . fromIntegral) <$> {#get cs_arm64_op->ext#} p) <*> do t <- fromIntegral <$> {#get cs_arm64_op->type#} p - let bP = plusPtr p 32 + let memP = plusPtr p {#offsetof cs_arm64_op->mem#} case toEnum t of - Arm64OpReg -> (Reg . toEnum . fromIntegral) <$> - (peek bP :: IO CUInt) - Arm64OpImm -> (Imm . fromIntegral) <$> (peek bP :: IO Int64) - Arm64OpCimm -> (CImm . fromIntegral) <$> (peek bP :: IO Int64) - Arm64OpFp -> (Fp . realToFrac) <$> (peek bP :: IO CDouble) - Arm64OpMem -> Mem <$> peek bP - Arm64OpRegMsr -> (Pstate . toEnum . fromIntegral) <$> - (peek bP :: IO CInt) - Arm64OpSys -> (Sys . fromIntegral) <$> (peek bP :: IO CUInt) - Arm64OpPrefetch -> (Prefetch . toEnum . fromIntegral) <$> - (peek bP :: IO CInt) - Arm64OpBarrier -> (Barrier . toEnum . fromIntegral) <$> - (peek bP :: IO CInt) + Arm64OpReg -> (Reg . toEnum . fromIntegral) <$> {#get cs_arm64_op->reg#} p + Arm64OpImm -> (Imm . fromIntegral) <$> {#get cs_arm64_op->imm#} p + Arm64OpCimm -> (CImm . fromIntegral) <$> {#get cs_arm64_op->imm#} p + Arm64OpFp -> (Fp . realToFrac) <$> {#get cs_arm64_op->fp#} p + Arm64OpMem -> Mem <$> (peek memP) + -- TODO: arm64_op_type has 3 fields Pstate/RegMsr/RegMrs, the old code was using Msr to set Pstate + Arm64OpPstate -> (Pstate . toEnum . fromIntegral) <$> {#get cs_arm64_op->pstate#} p + -- Arm64OpRegMsr -> (Pstate . toEnum . fromIntegral) <$> {#get cs_arm64_op->pstate#} + -- Arm64OpRegMrs -> (Pstate . toEnum . fromIntegral) <$> {#get cs_arm64_op->pstate#} + Arm64OpSys -> (Sys . fromIntegral) <$> {#get cs_arm64_op->sys#} p + Arm64OpPrefetch -> (Prefetch . toEnum . fromIntegral) <$> {#get cs_arm64_op->prefetch#} p + Arm64OpBarrier -> (Barrier . toEnum . fromIntegral) <$> {#get cs_arm64_op->barrier#} p _ -> return Undefined - <*> (peekByteOff p 44 :: IO Word8) -- access + <*> (fromIntegral <$> {#get cs_arm64_op->access#} p) poke p (CsArm64Op vI va ve (sh, shV) ext val acc) = do {#set cs_arm64_op->vector_index#} p (fromIntegral vI) {#set cs_arm64_op->vas#} p (fromIntegral $ fromEnum va) @@ -169,38 +168,45 @@ instance Storable CsArm64Op where {#set cs_arm64_op->shift.type#} p (fromIntegral $ fromEnum sh) {#set cs_arm64_op->shift.value#} p (fromIntegral shV) {#set cs_arm64_op->ext#} p (fromIntegral $ fromEnum ext) - let bP = plusPtr p 32 + let regP = plusPtr p {#offsetof cs_arm64_op->reg#} + immP = plusPtr p {#offsetof cs_arm64_op->imm#} + fpP = plusPtr p {#offsetof cs_arm64_op->fp#} + memP = plusPtr p {#offsetof cs_arm64_op->mem#} + pstateP = plusPtr p {#offsetof cs_arm64_op->pstate#} + sysP = plusPtr p {#offsetof cs_arm64_op->sys#} + prefetchP = plusPtr p {#offsetof cs_arm64_op->prefetch#} + barrierP = plusPtr p {#offsetof cs_arm64_op->barrier#} setType = {#set cs_arm64_op->type#} p . fromIntegral . fromEnum case val of Reg r -> do - poke bP (fromIntegral $ fromEnum r :: CUInt) + poke regP (fromIntegral $ fromEnum r :: CUInt) setType Arm64OpReg Imm i -> do - poke bP (fromIntegral i :: Int64) + poke immP (fromIntegral i :: Int64) setType Arm64OpImm CImm i -> do - poke bP (fromIntegral i :: Int64) + poke immP (fromIntegral i :: Int64) setType Arm64OpCimm Fp f -> do - poke bP (realToFrac f :: CDouble) + poke fpP (realToFrac f :: CDouble) setType Arm64OpFp Mem m -> do - poke bP m + poke memP m setType Arm64OpMem Pstate p -> do - poke bP (fromIntegral $ fromEnum p :: CInt) + poke pstateP (fromIntegral $ fromEnum p :: CInt) setType Arm64OpRegMsr Sys s -> do - poke bP (fromIntegral s :: CUInt) + poke sysP (fromIntegral s :: CUInt) setType Arm64OpSys Prefetch p -> do - poke bP (fromIntegral $ fromEnum p :: CInt) + poke prefetchP (fromIntegral $ fromEnum p :: CInt) setType Arm64OpPrefetch Barrier b -> do - poke bP (fromIntegral $ fromEnum b :: CInt) + poke barrierP (fromIntegral $ fromEnum b :: CInt) setType Arm64OpBarrier _ -> setType Arm64OpInvalid - pokeByteOff p 44 acc + {#set cs_arm64_op->access#} p $ fromIntegral acc -- | instruction datatype data CsArm64 = CsArm64 @@ -214,19 +220,19 @@ data CsArm64 = CsArm64 } deriving (Show, Eq) instance Storable CsArm64 where - sizeOf _ = 392 - alignment _ = 12 + sizeOf _ = {#sizeof cs_arm64#} + alignment _ = {#alignof cs_arm64#} peek p = CsArm64 <$> (toEnum . fromIntegral <$> {#get cs_arm64->cc#} p) - <*> (toBool <$> (peekByteOff p 4 :: IO Word8)) -- update_flags - <*> (toBool <$> (peekByteOff p 5 :: IO Word8)) -- writeback + <*> ({#get cs_arm64->update_flags#} p) + <*> ({#get cs_arm64->writeback#} p) <*> do num <- fromIntegral <$> {#get cs_arm64->op_count#} p let ptr = plusPtr p {#offsetof cs_arm64.operands#} peekArray num ptr poke p (CsArm64 cc uF w o) = do {#set cs_arm64->cc#} p (fromIntegral $ fromEnum cc) - pokeByteOff p 4 (fromBool uF :: Word8) -- update_flags - pokeByteOff p 5 (fromBool w :: Word8) -- writeback + {#set cs_arm64->update_flags#} p uF + {#set cs_arm64->writeback#} p w {#set cs_arm64->op_count#} p (fromIntegral $ length o) if length o > 8 then error "operands overflew 8 elements" diff --git a/src/Hapstone/Internal/Capstone.chs b/src/Hapstone/Internal/Capstone.chs index 27053a3..a9ea7e1 100644 --- a/src/Hapstone/Internal/Capstone.chs +++ b/src/Hapstone/Internal/Capstone.chs @@ -20,7 +20,7 @@ critical or greater versatility is needed. This means that the abstractions introduced in the C version of the library are still present, but their use has been restricted to provide more reasonable levels of safety. -} -module Hapstone.Internal.Capstone +module Hapstone.Internal.Capstone ( -- * Datatypes Csh , CsArch(..) @@ -169,11 +169,15 @@ data ArchInfo = X86 X86.CsX86 -- ^ x86 architecture | Arm64 Arm64.CsArm64 -- ^ ARM64 architecture | Arm Arm.CsArm -- ^ ARM architecture + -- | M68k M68k.CsM68k -- ^ M68K architecture | Mips Mips.CsMips -- ^ MIPS architecture | Ppc Ppc.CsPpc -- ^ PPC architecture | Sparc Sparc.CsSparc -- ^ SPARC architecture | SysZ SystemZ.CsSysZ -- ^ SystemZ architecture | XCore XCore.CsXCore -- ^ XCore architecture + -- | Tms320c64x Tms320c64x.CsTms320c64x -- ^ TMS320C64x architecture + -- | M680x M680x.CsM680x -- ^ M680X architecture + -- | Evm Evm.CsEvm -- ^ Ethereum architecture deriving (Show, Eq) -- | instruction information @@ -223,11 +227,15 @@ instance Storable CsDetail where Just (X86 x) -> poke bP x Just (Arm64 x) -> poke bP x Just (Arm x) -> poke bP x + -- Just (M68k x) -> poke bP x Just (Mips x) -> poke bP x Just (Ppc x) -> poke bP x Just (Sparc x) -> poke bP x Just (SysZ x) -> poke bP x Just (XCore x) -> poke bP x + -- Just (Tms320c64x x) -> poke bP x + -- Just (M680x x) -> poke bP x + -- Just (Evm x) -> poke bP x Nothing -> return () -- | an arch-sensitive peek for cs_detail @@ -244,6 +252,11 @@ peekDetail arch p = do CsArchSparc -> Sparc <$> peek bP CsArchSysz -> SysZ <$> peek bP CsArchXcore -> XCore <$> peek bP + -- CsArchM68k -> M68k <$> peek bP + -- CsArchTms320C64x -> Tms320c64x <$> peek bP + -- CsArchM680x -> M680x <$> peek bP + -- CsArchEvm -> Evm <$> peek bP + -- CsArchMax -> Max <$> peek bP return detail { archInfo = Just aI } -- | instructions @@ -297,7 +310,7 @@ instance Storable CsInsn where poke csDetailPtr d' {#set cs_insn->detail#} p (castPtr csDetailPtr) --- | an arch-sensitive peek for cs_insn +-- | an arch-sensitive peek for cs_insn peekArch :: CsArch -> Ptr CsInsn -> IO CsInsn peekArch arch p = do insn <- peek p diff --git a/src/Hapstone/Internal/Mips.chs b/src/Hapstone/Internal/Mips.chs index bf900bb..84da606 100644 --- a/src/Hapstone/Internal/Mips.chs +++ b/src/Hapstone/Internal/Mips.chs @@ -37,7 +37,7 @@ import Foreign.C.Types -- | memory access operands -- associated with 'MipsOpMem' operand type -data MipsOpMemStruct = MipsOpMemStruct +data MipsOpMemStruct = MipsOpMemStruct { base :: MipsReg -- ^ base register , disp :: Int64 -- ^ displacement/offset value } deriving (Show, Eq) @@ -50,39 +50,41 @@ instance Storable MipsOpMemStruct where <*> (fromIntegral <$> {#get mips_op_mem->disp#} p) poke p (MipsOpMemStruct b d) = do {#set mips_op_mem->base#} p (fromIntegral $ fromEnum b) - {#set mips_op_mem->disp#} p(fromIntegral d) + {#set mips_op_mem->disp#} p (fromIntegral d) -- | instruction operand data CsMipsOp - = Reg Word32 -- ^ register value for 'MipsOpReg' operands + = Reg MipsReg -- ^ register value for 'MipsOpReg' operands | Imm Int64 -- ^ immediate value for 'MipsOpImm' operands | Mem MipsOpMemStruct -- ^ base,disp value for 'MipsOpMem' operands | Undefined -- ^ invalid operand value, for MipsOpInvalid operand deriving (Show, Eq) instance Storable CsMipsOp where - sizeOf _ = 24 - alignment _ = 8 + sizeOf _ = {#sizeof mips_op_mem#} + alignment _ = {#alignof mips_op_mem#} peek p = do t <- fromIntegral <$> {#get cs_mips_op->type#} p - let bP = plusPtr p 8 + let memP = plusPtr p {#offsetof cs_mips_op->mem#} case toEnum t of - MipsOpReg -> (Reg . fromIntegral) <$> (peek bP :: IO CUInt) - MipsOpImm -> (Imm . fromIntegral) <$> (peek bP :: IO Int64) - MipsOpMem -> Mem <$> (peek bP :: IO MipsOpMemStruct) + MipsOpReg -> (Reg . toEnum . fromIntegral) <$> {#get cs_mips_op->reg#} p + MipsOpImm -> (Imm . fromIntegral) <$> {#get cs_mips_op->imm#} p + MipsOpMem -> Mem <$> peek memP _ -> return Undefined poke p op = do - let bP = plusPtr p 8 + let regP = plusPtr p {#offsetof cs_mips_op->reg#} + immP = plusPtr p {#offsetof cs_mips_op->imm#} + memP = plusPtr p {#offsetof cs_mips_op->mem#} setType = {#set cs_mips_op->type#} p . fromIntegral . fromEnum case op of Reg r -> do - poke bP (fromIntegral r :: CUInt) + poke regP (fromIntegral $ fromEnum r :: CUInt) setType MipsOpReg Imm i -> do - poke bP (fromIntegral i :: Int64) + poke immP i setType MipsOpImm Mem m -> do - poke bP m + poke memP m setType MipsOpMem _ -> setType MipsOpInvalid @@ -95,17 +97,17 @@ newtype CsMips = CsMips [CsMipsOp] -- ^ operand list for this instruction, deriving (Show, Eq) instance Storable CsMips where - sizeOf _ = 200 - alignment _ = 8 + sizeOf _ = {#sizeof cs_mips#} + alignment _ = {#alignof cs_mips#} peek p = CsMips <$> do num <- fromIntegral <$> {#get cs_mips->op_count#} p - let ptr = plusPtr p 8 + let ptr = plusPtr p {#offsetof cs_mips->operands#} peekArray num ptr poke p (CsMips o) = do {#set cs_mips->op_count#} p (fromIntegral $ length o) - if length o > 8 + if length o > 10 then error "operands overflew 8 elements" - else pokeArray (plusPtr p 8) o + else pokeArray (plusPtr p {#offsetof cs_mips->operands#}) o -- | MIPS instructions {#enum mips_insn as MipsInsn {underscoreToCase} diff --git a/src/Hapstone/Internal/Ppc.chs b/src/Hapstone/Internal/Ppc.chs index e799032..789dbb9 100644 --- a/src/Hapstone/Internal/Ppc.chs +++ b/src/Hapstone/Internal/Ppc.chs @@ -44,7 +44,7 @@ import Foreign.C.Types -- | memory access operands -- associated with 'Ppc64OpMem' operand type -data PpcOpMemStruct = PpcOpMemStruct +data PpcOpMemStruct = PpcOpMemStruct { base :: PpcReg -- ^ base register , disp :: Int32 -- ^ displacement/offset value } deriving (Show, Eq) @@ -82,44 +82,48 @@ instance Storable PpcOpCrxStruct where -- | instruction operands data CsPpcOp = Reg PpcReg -- ^ register value for 'PpcOpReg' operands - | Imm Int32 -- ^ immediate value for 'PpcOpImm' operands + | Imm Int64 -- ^ immediate value for 'PpcOpImm' operands | Mem PpcOpMemStruct -- ^ base/disp value for 'PpcOpMem' operands | Crx PpcOpCrxStruct -- ^ operand with condition register | Undefined -- ^ invalid operand value, for 'PpcOpInvalid' operand deriving (Show, Eq) instance Storable CsPpcOp where - sizeOf _ = 16 - alignment _ = 4 + sizeOf _ = {#sizeof cs_ppc_op#} + alignment _ = {#alignof cs_ppc_op#} peek p = do t <- fromIntegral <$> {#get cs_ppc_op->type#} p - let bP = plusPtr p 4 + let memP = plusPtr p {#offsetof cs_ppc_op->mem#} + crxP = plusPtr p {#offsetof cs_ppc_op->crx#} case toEnum t of - PpcOpReg -> (Reg . toEnum . fromIntegral) <$> (peek bP :: IO CInt) - PpcOpImm -> Imm <$> peek bP - PpcOpMem -> Mem <$> peek bP - PpcOpCrx -> Crx <$> peek bP + PpcOpReg -> (Reg . toEnum . fromIntegral) <$> {#get cs_ppc_op->reg#} p + PpcOpImm -> (Imm . fromIntegral) <$> {#get cs_ppc_op->imm#} p + PpcOpMem -> Mem <$> peek memP + PpcOpCrx -> Crx <$> peek crxP _ -> return Undefined poke p op = do - let bP = plusPtr p 4 + let regP = plusPtr p {#offsetof cs_ppc_op->reg#} + immP = plusPtr p {#offsetof cs_ppc_op->imm#} + memP = plusPtr p {#offsetof cs_ppc_op->mem#} + crxP = plusPtr p {#offsetof cs_ppc_op->crx#} setType = {#set cs_ppc_op->type#} p . fromIntegral . fromEnum case op of Reg r -> do - poke bP (fromIntegral $ fromEnum r :: CInt) + poke regP (fromIntegral $ fromEnum r :: CInt) setType PpcOpReg Imm i -> do - poke bP i + poke immP i setType PpcOpImm Mem m -> do - poke bP m + poke memP m setType PpcOpMem Crx c -> do - poke bP c + poke crxP c setType PpcOpCrx _ -> setType PpcOpInvalid -- | instruction datatype -data CsPpc = CsPpc +data CsPpc = CsPpc { bc :: PpcBc -- ^ branch code for branch instructions , bh :: PpcBh -- ^ branch hint for branch instructions , updateCr0 :: Bool -- ^ does this instruction update CR0? @@ -130,19 +134,19 @@ data CsPpc = CsPpc } deriving (Show, Eq) instance Storable CsPpc where - sizeOf _ = 140 - alignment _ = 4 + sizeOf _ = {#sizeof cs_ppc#} + alignment _ = {#alignof cs_ppc#} peek p = CsPpc <$> ((toEnum . fromIntegral) <$> {#get cs_ppc->bc#} p) <*> ((toEnum . fromIntegral) <$> {#get cs_ppc->bh#} p) - <*> (toBool <$> (peekByteOff p 8 :: IO Word8)) -- update_cr0 + <*> {#get cs_ppc->update_cr0#} p <*> do num <- fromIntegral <$> {#get cs_ppc->op_count#} p let ptr = plusPtr p {#offsetof cs_ppc.operands#} peekArray num ptr poke p (CsPpc bc bh u o) = do {#set cs_ppc->bc#} p (fromIntegral $ fromEnum bc) {#set cs_ppc->bh#} p (fromIntegral $ fromEnum bh) - pokeByteOff p 8 (fromBool u :: Word8) -- update_cr0 + {#set cs_ppc->update_cr0#} p u {#set cs_ppc->op_count#} p (fromIntegral $ length o) if length o > 8 then error "operands overflew 8 elements" diff --git a/src/Hapstone/Internal/Sparc.chs b/src/Hapstone/Internal/Sparc.chs index 80ff919..2ad2878 100644 --- a/src/Hapstone/Internal/Sparc.chs +++ b/src/Hapstone/Internal/Sparc.chs @@ -64,35 +64,37 @@ instance Storable SparcOpMemStruct where -- | instruction operand data CsSparcOp - = Reg Word32 -- ^ register value for 'SparcOpReg' operands - | Imm Int32 -- ^ immediate value for 'SparcOpImm' operands + = Reg SparcOpType -- ^ register value for 'SparcOpReg' operands + | Imm Int64 -- ^ immediate value for 'SparcOpImm' operands | Mem SparcOpMemStruct -- ^ base,index,disp value for 'SparcOpMem' operands | Undefined -- ^ invalid operand value, for 'SparcOpInvalid' operand deriving (Show, Eq) instance Storable CsSparcOp where - sizeOf _ = 12 - alignment _ = 4 + sizeOf _ = {#sizeof cs_sparc_op#} + alignment _ = {#alignof cs_sparc_op#} peek p = do t <- fromIntegral <$> ({#get cs_sparc_op->type#} p :: IO CInt) - let bP = plusPtr p 4 + let memP = plusPtr p {#offsetof cs_sparc_op->mem#} case toEnum t of - SparcOpReg -> Reg <$> peek bP - SparcOpImm -> Imm <$> peek bP - SparcOpMem -> Mem <$> peek bP + SparcOpReg -> (Reg . toEnum . fromIntegral) <$> {#get cs_sparc_op->reg#} p + SparcOpImm -> (Imm . fromIntegral) <$> {#get cs_sparc_op->imm#} p + SparcOpMem -> Mem <$> peek memP _ -> return Undefined poke p op = do - let bP = plusPtr p 4 + let regP = plusPtr p {#offsetof cs_sparc_op->reg#} + immP = plusPtr p {#offsetof cs_sparc_op->imm#} + memP = plusPtr p {#offsetof cs_sparc_op->mem#} setType = {#set cs_sparc_op->type#} p . fromIntegral . fromEnum case op of Reg r -> do - poke bP (fromIntegral $ fromEnum r :: CInt) + poke regP (fromIntegral $ fromEnum r :: CInt) setType SparcOpReg Imm i -> do - poke bP i + poke immP i setType SparcOpImm Mem m -> do - poke bP m + poke memP m setType SparcOpMem _ -> setType SparcOpInvalid @@ -107,8 +109,8 @@ data CsSparc = CsSparc } deriving (Show, Eq) instance Storable CsSparc where - sizeOf _ = 60 - alignment _ = 4 + sizeOf _ = {#sizeof cs_sparc#} + alignment _ = {#alignof cs_sparc#} peek p = CsSparc <$> ((toEnum . fromIntegral) <$> {#get cs_sparc->cc#} p) <*> ((toEnum . fromIntegral) <$> {#get cs_sparc->hint#} p) diff --git a/src/Hapstone/Internal/SystemZ.chs b/src/Hapstone/Internal/SystemZ.chs index c612f04..f871a3d 100644 --- a/src/Hapstone/Internal/SystemZ.chs +++ b/src/Hapstone/Internal/SystemZ.chs @@ -63,7 +63,7 @@ instance Storable SysZOpMemStruct where -- | instruction operand data CsSysZOp - = Reg Word32 -- ^ register value for 'SyszOpReg' operands + = Reg SysZReg -- ^ register value for 'SyszOpReg' operands | Imm Int64 -- ^ immediate value for 'SyszOpImm' operands | Mem SysZOpMemStruct -- ^ base/index/length/disp value for 'SyszOpMem' -- operands @@ -72,29 +72,31 @@ data CsSysZOp deriving (Show, Eq) instance Storable CsSysZOp where - sizeOf _ = 32 - alignment _ = 8 + sizeOf _ = {#sizeof cs_sysz_op#} + alignment _ = {#alignof cs_sysz_op#} peek p = do t <- fromIntegral <$> {#get cs_sysz_op->type#} p - let bP = plusPtr p 8 + let memP = plusPtr p {#offsetof cs_sysz_op->mem#} case toEnum t of - SyszOpReg -> Reg <$> peek bP - SyszOpImm -> Imm <$> peek bP - SyszOpMem -> Mem <$> peek bP + SyszOpReg -> (Reg . toEnum . fromIntegral) <$> {#get cs_sysz_op->reg#} p + SyszOpImm -> (Imm . fromIntegral) <$> {#get cs_sysz_op->reg#} p + SyszOpMem -> Mem <$> peek memP SyszOpAcreg -> return AcReg SyszOpInvalid -> return Undefined poke p op = do - let bP = plusPtr p 8 + let regP = plusPtr p {#offsetof cs_sysz_op->reg#} + immP = plusPtr p {#offsetof cs_sysz_op->imm#} + memP = plusPtr p {#offsetof cs_sysz_op->mem#} setType = {#set cs_sysz_op->type#} p . fromIntegral . fromEnum case op of Reg r -> do - poke bP (fromIntegral $ fromEnum r :: CInt) + poke regP (fromIntegral $ fromEnum r :: CInt) setType SyszOpReg Imm i -> do - poke bP i + poke immP i setType SyszOpImm Mem m -> do - poke bP m + poke memP m setType SyszOpMem AcReg -> setType SyszOpAcreg _ -> setType SyszOpInvalid @@ -109,8 +111,8 @@ data CsSysZ = CsSysZ } deriving (Show, Eq) instance Storable CsSysZ where - sizeOf _ = 200 - alignment _ = 8 + sizeOf _ = {#sizeof cs_sysz#} + alignment _ = {#alignof cs_sysz#} peek p = CsSysZ <$> ((toEnum . fromIntegral) <$> {#get cs_sysz->cc#} p) <*> do num <- fromIntegral <$> {#get cs_sysz->op_count#} p diff --git a/src/Hapstone/Internal/X86.chs b/src/Hapstone/Internal/X86.chs index d04d8bb..3e4a3ee 100644 --- a/src/Hapstone/Internal/X86.chs +++ b/src/Hapstone/Internal/X86.chs @@ -20,8 +20,6 @@ source file. -} module Hapstone.Internal.X86 where --- ugly workaround because... capstone doesn't import stdbool.h -#include #include {#context lib = "capstone"#} @@ -38,12 +36,103 @@ import Hapstone.Internal.Util {#enum x86_reg as X86Reg {underscoreToCase} deriving (Show, Eq, Bounded)#} --- TODO: add X86_EFLAGS_* flags as enum +-- | x86 eflags +{#enum define X86EFlags + { X86_EFLAGS_MODIFY_AF as X86EflagsModifyAf + , X86_EFLAGS_MODIFY_CF as X86EflagsModifyCf + , X86_EFLAGS_MODIFY_SF as X86EflagsModifySf + , X86_EFLAGS_MODIFY_ZF as X86EflagsModifyZf + , X86_EFLAGS_MODIFY_PF as X86EflagsModifyPf + , X86_EFLAGS_MODIFY_OF as X86EflagsModifyOf + , X86_EFLAGS_MODIFY_TF as X86EflagsModifyTf + , X86_EFLAGS_MODIFY_IF as X86EflagsModifyIf + , X86_EFLAGS_MODIFY_DF as X86EflagsModifyDf + , X86_EFLAGS_MODIFY_NT as X86EflagsModifyNt + , X86_EFLAGS_MODIFY_RF as X86EflagsModifyRf + , X86_EFLAGS_PRIOR_OF as X86EflagsPriorOf + , X86_EFLAGS_PRIOR_SF as X86EflagsPriorSf + , X86_EFLAGS_PRIOR_ZF as X86EflagsPriorZf + , X86_EFLAGS_PRIOR_AF as X86EflagsPriorAf + , X86_EFLAGS_PRIOR_PF as X86EflagsPriorPf + , X86_EFLAGS_PRIOR_CF as X86EflagsPriorCf + , X86_EFLAGS_PRIOR_TF as X86EflagsPriorTf + , X86_EFLAGS_PRIOR_IF as X86EflagsPriorIf + , X86_EFLAGS_PRIOR_DF as X86EflagsPriorDf + , X86_EFLAGS_PRIOR_NT as X86EflagsPriorNt + , X86_EFLAGS_RESET_OF as X86EflagsResetOf + , X86_EFLAGS_RESET_CF as X86EflagsResetCf + , X86_EFLAGS_RESET_DF as X86EflagsResetDf + , X86_EFLAGS_RESET_IF as X86EflagsResetIf + , X86_EFLAGS_RESET_SF as X86EflagsResetSf + , X86_EFLAGS_RESET_AF as X86EflagsResetAf + , X86_EFLAGS_RESET_TF as X86EflagsResetTf + , X86_EFLAGS_RESET_NT as X86EflagsResetNt + , X86_EFLAGS_RESET_PF as X86EflagsResetPf + , X86_EFLAGS_SET_CF as X86EflagsSetCf + , X86_EFLAGS_SET_DF as X86EflagsSetDf + , X86_EFLAGS_SET_IF as X86EflagsSetIf + , X86_EFLAGS_TEST_OF as X86EflagsTestOf + , X86_EFLAGS_TEST_SF as X86EflagsTestSf + , X86_EFLAGS_TEST_ZF as X86EflagsTestZf + , X86_EFLAGS_TEST_PF as X86EflagsTestPf + , X86_EFLAGS_TEST_CF as X86EflagsTestCf + , X86_EFLAGS_TEST_NT as X86EflagsTestNt + , X86_EFLAGS_TEST_DF as X86EflagsTestDf + , X86_EFLAGS_UNDEFINED_OF as X86EflagsUndefinedOf + , X86_EFLAGS_UNDEFINED_SF as X86EflagsUndefinedSf + , X86_EFLAGS_UNDEFINED_ZF as X86EflagsUndefinedZf + , X86_EFLAGS_UNDEFINED_PF as X86EflagsUndefinedPf + , X86_EFLAGS_UNDEFINED_AF as X86EflagsUndefinedAf + , X86_EFLAGS_UNDEFINED_CF as X86EflagsUndefinedCf + , X86_EFLAGS_RESET_RF as X86EflagsResetRf + , X86_EFLAGS_TEST_RF as X86EflagsTestRf + , X86_EFLAGS_TEST_IF as X86EflagsTestIf + , X86_EFLAGS_TEST_TF as X86EflagsTestTf + , X86_EFLAGS_TEST_AF as X86EflagsTestAf + , X86_EFLAGS_RESET_ZF as X86EflagsResetZf + , X86_EFLAGS_SET_OF as X86EflagsSetOf + , X86_EFLAGS_SET_SF as X86EflagsSetSf + , X86_EFLAGS_SET_ZF as X86EflagsSetZf + , X86_EFLAGS_SET_AF as X86EflagsSetAf + , X86_EFLAGS_SET_PF as X86EflagsSetPf + , X86_EFLAGS_RESET_0F as X86EflagsReset0F + , X86_EFLAGS_RESET_AC as X86EflagsResetAc + } + deriving (Show, Eq, Bounded)#} + +-- | x86 fpu flags +{#enum define X86FpuFlags + { X86_FPU_FLAGS_MODIFY_C0 as X86FpuFlagsModifyC0 + , X86_FPU_FLAGS_MODIFY_C1 as X86FpuFlagsModifyC1 + , X86_FPU_FLAGS_MODIFY_C2 as X86FpuFlagsModifyC2 + , X86_FPU_FLAGS_MODIFY_C3 as X86FpuFlagsModifyC3 + , X86_FPU_FLAGS_RESET_C0 as X86FpuFlagsResetC0 + , X86_FPU_FLAGS_RESET_C1 as X86FpuFlagsResetC1 + , X86_FPU_FLAGS_RESET_C2 as X86FpuFlagsResetC2 + , X86_FPU_FLAGS_RESET_C3 as X86FpuFlagsResetC3 + , X86_FPU_FLAGS_SET_C0 as X86FpuFlagsSetC0 + , X86_FPU_FLAGS_SET_C1 as X86FpuFlagsSetC1 + , X86_FPU_FLAGS_SET_C2 as X86FpuFlagsSetC2 + , X86_FPU_FLAGS_SET_C3 as X86FpuFlagsSetC3 + , X86_FPU_FLAGS_UNDEFINED_C0 as X86FpuFlagsUndefinedC0 + , X86_FPU_FLAGS_UNDEFINED_C1 as X86FpuFlagsUndefinedC1 + , X86_FPU_FLAGS_UNDEFINED_C2 as X86FpuFlagsUndefinedC2 + , X86_FPU_FLAGS_UNDEFINED_C3 as X86FpuFlagsUndefinedC3 + , X86_FPU_FLAGS_TEST_C0 as X86FpuFlagsTestC0 + , X86_FPU_FLAGS_TEST_C1 as X86FpuFlagsTestC1 + , X86_FPU_FLAGS_TEST_C2 as X86FpuFlagsTestC2 + , X86_FPU_FLAGS_TEST_C3 as X86FpuFlagsTestC3 + } + deriving (Show, Eq, Bounded)#} -- | operand type for instruction's operands {#enum x86_op_type as X86OpType {underscoreToCase} deriving (Show, Eq, Bounded)#} +-- | XOP code condition +{#enum x86_xop_cc as X86XopCc {underscoreToCase} + deriving (Show, Eq, Bounded)#} + -- | AVX broadcast {#enum x86_avx_bcast as X86AvxBcast {underscoreToCase} deriving (Show, Eq, Bounded)#} @@ -90,7 +179,6 @@ instance Storable X86OpMemStruct where data CsX86OpValue = Reg X86Reg -- ^ register value for 'X86OpReg' operands | Imm Word64 -- ^ immediate value for 'X86OpImm' operands - -- | Fp Double ^ floating point value for 'X86OpFp' operands | Mem X86OpMemStruct -- ^ segment,base,index,scale,disp value for -- 'X86OpMem' operands | Undefined -- ^ invalid operand value, for 'X86OpInvalid' operand @@ -106,45 +194,68 @@ data CsX86Op = CsX86Op } deriving (Show, Eq) instance Storable CsX86Op where - sizeOf _ = 48 - alignment _ = 8 + sizeOf _ = {#sizeof cs_x86_op#} + alignment _ = {#alignof cs_x86_op#} peek p = CsX86Op <$> do t <- fromIntegral <$> {#get cs_x86_op->type#} p - let bP = plusPtr p 8 case toEnum t of - X86OpReg -> (Reg . toEnum . fromIntegral) <$> - (peek bP :: IO CInt) - X86OpImm -> Imm <$> peek bP - -- X86OpFp -> (Fp . realToFrac) <$> (peek bP :: IO CDouble) - X86OpMem -> Mem <$> peek bP + X86OpReg -> (Reg . toEnum . fromIntegral) <$> {#get cs_x86_op->reg#} p + X86OpImm -> (Imm . fromIntegral) <$> {#get cs_x86_op->imm#} p + X86OpMem -> Mem <$> (peek (plusPtr p {#offsetof cs_x86_op->mem#})) _ -> return Undefined - <*> (peekByteOff p 32) -- size - <*> (peekByteOff p 33) -- access - <*> ((toEnum . fromIntegral) <$> - (peekByteOff p 36 :: IO CInt)) -- avx_bcast - <*> (toBool <$> (peekByteOff p 40 :: IO Word8)) -- avx_zero_opmask + <*> (fromIntegral <$> {#get cs_x86_op->size#} p) + <*> (fromIntegral <$> {#get cs_x86_op->access#} p) + <*> ((toEnum . fromIntegral) <$> {#get cs_x86_op->avx_bcast#} p) + <*> ({#get cs_x86_op->avx_zero_opmask#} p) poke p (CsX86Op val s a ab az) = do - let bP = plusPtr p 8 + let regP = plusPtr p {#offsetof cs_x86_op->reg#} + immP = plusPtr p {#offsetof cs_x86_op->imm#} + memP = plusPtr p {#offsetof cs_x86_op->mem#} setType = {#set cs_x86_op->type#} p . fromIntegral . fromEnum case val of Reg r -> do - poke bP (fromIntegral $ fromEnum r :: CInt) + poke regP (fromIntegral $ fromEnum r :: CInt) setType X86OpReg Imm i -> do - poke bP i + poke immP i setType X86OpImm - {- Fp f -> do - poke bP (realToFrac f :: CDouble) - setType X86OpFp -} Mem m -> do - poke bP m + poke memP m setType X86OpMem Undefined -> setType X86OpInvalid - pokeByteOff p 32 s -- size - pokeByteOff p 33 a -- access - pokeByteOff p 36 (fromIntegral $ fromEnum ab :: CInt) -- avx_bcast - pokeByteOff p 40 (fromBool az :: Word8) -- avx_zero_opmask + {#set cs_x86_op->size#} p (fromIntegral s) + {#set cs_x86_op->access#} p (fromIntegral a) + {#set cs_x86_op->access#} p (fromIntegral $ fromEnum ab) + {#set cs_x86_op->avx_zero_opmask#} p az + +data CsX86Encoding = CsX86Encoding + { modRMOffset :: Word8 + , dispOffset :: Word8 + , dispSize :: Word8 + , immOffset :: Word8 + , immSize :: Word8 + } deriving (Show, Eq) + +instance Storable CsX86Encoding where + sizeOf _ = {#sizeof cs_x86_encoding#} + alignment _ = {#alignof cs_x86_encoding#} + peek p = CsX86Encoding + <$> (fromIntegral <$> {#get cs_x86_encoding->modrm_offset#} p) + <*> ((fromIntegral <$> {#get cs_x86_encoding->disp_offset#} p)) + <*> (fromIntegral <$> {#get cs_x86_encoding->disp_size#} p) + <*> (fromIntegral <$> {#get cs_x86_encoding->imm_offset#} p) + <*> (fromIntegral <$> {#get cs_x86_encoding->imm_size#} p) + poke p (CsX86Encoding moff doff dsize ioff isize) = do + {#set cs_x86_encoding->modrm_offset#} p (fromIntegral moff) + {#set cs_x86_encoding->disp_size#} p (fromIntegral doff) + {#set cs_x86_encoding->disp_size#} p (fromIntegral dsize) + {#set cs_x86_encoding->imm_offset#} p (fromIntegral ioff) + {#set cs_x86_encoding->imm_size#} p (fromIntegral isize) + +data CsX86Flags + = EFlags Word64 + | FpuFlags Word64 -- instructions data CsX86 = CsX86 @@ -158,23 +269,26 @@ data CsX86 = CsX86 , addrSize :: Word8 -- ^ address size , modRM :: Word8 -- ^ ModR/M byte , sib :: Maybe Word8 -- ^ optional SIB value - , disp :: Maybe Int32 -- ^ optional displacement value + , disp :: Maybe Int64 -- ^ optional displacement value , sibIndex :: X86Reg -- ^ SIB index register, possibly irrelevant , sibScale :: Int8 -- ^ SIB scale, possibly irrelevant , sibBase :: X86Reg -- ^ SIB base register, possibly irrelevant + , xopCc :: X86XopCc -- ^ XOP code instruction , sseCc :: X86SseCc -- ^ SSE condition code , avxCc :: X86AvxCc -- ^ AVX condition code , avxSae :: Bool -- ^ AXV Supress all Exception , avxRm :: X86AvxRm -- ^ AVX static rounding mode + , flags :: Word64 -- ^ flags updated by this instruction , operands :: [CsX86Op] -- ^ operand list for this instruction, *MUST* -- have <= 8 elements, else you'll get a runtime -- error when you (implicitly) try to write it to -- memory via it's Storable instance + , encoding :: CsX86Encoding } deriving (Show, Eq) instance Storable CsX86 where - sizeOf _ = 432 - alignment _ = 8 + sizeOf _ = {#sizeof cs_x86#} + alignment _ = {#alignof cs_x86#} peek p = CsX86 <$> do let bP = plusPtr p {#offsetof cs_x86->prefix#} [p0, p1, p2, p3] <- peekArray 4 bP :: IO [Word8] @@ -189,14 +303,18 @@ instance Storable CsX86 where <*> ((toEnum . fromIntegral) <$> {#get cs_x86->sib_index#} p) -- 16 <*> (fromIntegral <$> {#get cs_x86->sib_scale#} p) <*> ((toEnum . fromIntegral) <$> {#get cs_x86->sib_base#} p) + <*> ((toEnum . fromIntegral) <$> {#get cs_x86->xop_cc#} p) <*> ((toEnum . fromIntegral) <$> {#get cs_x86->sse_cc#} p) <*> ((toEnum . fromIntegral) <$> {#get cs_x86->avx_cc#} p) - <*> (toBool <$> (peekByteOff p {#offsetof cs_x86->avx_sae#} :: IO Word8)) -- avx_sae + <*> ({#get cs_x86->avx_sae#} p) <*> ((toEnum . fromIntegral) <$> {#get cs_x86->avx_rm#} p) + <*> (fromIntegral <$> {#get cs_x86->eflags#} p) <*> do num <- (fromIntegral <$> {#get cs_x86->op_count#} p) let ptr = plusPtr p {#offsetof cs_x86->operands#} peekArray num ptr - poke p (CsX86 (p0, p1, p2, p3) op r a m s d sI sS sB sC aC aS aR o) = + <*> (peekByteOff p {#offsetof cs_x86->encoding#}) + -- <*> ({#get cs_x86->encoding#} p) + poke p (CsX86 (p0, p1, p2, p3) op r a m s d sI sS sB xC sC aC aS aR f o e) = do let p' = [ fromMaybe 0 p0 , fromMaybe 0 p1 @@ -214,11 +332,14 @@ instance Storable CsX86 where {#set cs_x86->sib_index#} p (fromIntegral $ fromEnum sI) {#set cs_x86->sib_scale#} p (fromIntegral sS) {#set cs_x86->sib_base#} p (fromIntegral $ fromEnum sB) + {#set cs_x86->xop_cc#} p (fromIntegral $ fromEnum xC) {#set cs_x86->sse_cc#} p (fromIntegral $ fromEnum sC) {#set cs_x86->avx_cc#} p (fromIntegral $ fromEnum aC) - pokeByteOff p {#offsetof cs_x86->avx_sae#} (fromBool aS :: Word8) -- avx_sae + {#set cs_x86->avx_sae#} p aS {#set cs_x86->avx_rm#} p (fromIntegral $ fromEnum aR) + {#set cs_x86->eflags#} p (fromIntegral f) {#set cs_x86->op_count#} p (fromIntegral $ length o) + pokeByteOff p {#offsetof cs_x86->encoding#} e if length o > 8 then error "operands overflew 8 elements" else pokeArray (plusPtr p {#offsetof cs_x86->operands#}) o diff --git a/src/Hapstone/Internal/XCore.chs b/src/Hapstone/Internal/XCore.chs index 73e6076..80cc6fd 100644 --- a/src/Hapstone/Internal/XCore.chs +++ b/src/Hapstone/Internal/XCore.chs @@ -68,24 +68,26 @@ data CsXCoreOp deriving (Show, Eq) instance Storable CsXCoreOp where - sizeOf _ = 16 - alignment _ = 4 + sizeOf _ = {#sizeof cs_xcore_op#} + alignment _ = {#alignof cs_xcore_op#} peek p = do t <- fromIntegral <$> {#get cs_xcore_op->type#} p - let bP = plusPtr p 4 + let memP = plusPtr p {#offsetof cs_xcore_op->mem#} case toEnum t of - XcoreOpReg -> (Reg . toEnum . fromIntegral) <$> (peek bP :: IO Int32) - XcoreOpImm -> Imm <$> peek bP - XcoreOpMem -> Mem <$> peek bP + XcoreOpReg -> (Reg . toEnum . fromIntegral) <$> {#get cs_xcore_op->reg#} p + XcoreOpImm -> (Imm . fromIntegral) <$> {#get cs_xcore_op->imm#} p + XcoreOpMem -> Mem <$> peek memP _ -> return Undefined poke p op = do - let bP = plusPtr p 4 + let regP = plusPtr p {#offsetof cs_xcore_op->reg#} + immP = plusPtr p {#offsetof cs_xcore_op->imm#} + memP = plusPtr p {#offsetof cs_xcore_op->mem#} setType = {#set cs_xcore_op->type#} p . fromIntegral . fromEnum case op of - Reg r -> do poke bP (fromIntegral $ fromEnum r :: Int32) + Reg r -> do poke regP (fromIntegral $ fromEnum r :: Int32) setType XcoreOpReg - Imm i -> poke bP i >> setType XcoreOpImm - Mem m -> poke bP m >> setType XcoreOpMem + Imm i -> poke immP i >> setType XcoreOpImm + Mem m -> poke memP m >> setType XcoreOpMem _ -> setType XcoreOpInvalid -- | instruction datatype @@ -97,8 +99,8 @@ newtype CsXCore = CsXCore [CsXCoreOp] -- ^ operand list of this instruction, deriving (Show, Eq) instance Storable CsXCore where - sizeOf _ = 132 - alignment _ = 4 + sizeOf _ = {#sizeof cs_xcore#} + alignment _ = {#alignof cs_xcore#} peek p = do num <- fromIntegral <$> {#get cs_xcore->op_count#} p CsXCore <$> peekArray num (plusPtr p {#offsetof cs_xcore.operands#}) diff --git a/stack.yaml b/stack.yaml index 583bb57..1fbff69 100644 --- a/stack.yaml +++ b/stack.yaml @@ -1,14 +1,16 @@ # For more information, see: http://docs.haskellstack.org/en/stable/yaml_configuration.html # Specifies the GHC version and set of packages available (e.g., lts-3.5, nightly-2015-09-21, ghc-7.10.2) -resolver: lts-8.13 +resolver: lts-15.10 # Local packages, usually specified by relative directory name packages: - '.' # Packages to be pulled from upstream that are not in the resolver (e.g., acme-missiles-0.3) -extra-deps: [] +extra-deps: +- git: https://github.com/haskell/c2hs + commit: e64e0b2de00c9566e1dd832d9a9b8285b80669ee # Override default flag values for local packages and extra-deps flags: {} From 2409388f303c10d2dbf430d90654b12cbcedd4dd Mon Sep 17 00:00:00 2001 From: nganhkhoa Date: Mon, 1 Jun 2020 11:44:35 +0000 Subject: [PATCH 02/21] update new archs --- src/Hapstone/Internal/Evm.chs | 56 +++++++ src/Hapstone/Internal/M680x.chs | 193 ++++++++++++++++++++++ src/Hapstone/Internal/M68k.chs | 235 +++++++++++++++++++++++++++ src/Hapstone/Internal/Tms320c64x.chs | 164 +++++++++++++++++++ 4 files changed, 648 insertions(+) create mode 100644 src/Hapstone/Internal/Evm.chs create mode 100644 src/Hapstone/Internal/M680x.chs create mode 100644 src/Hapstone/Internal/M68k.chs create mode 100644 src/Hapstone/Internal/Tms320c64x.chs diff --git a/src/Hapstone/Internal/Evm.chs b/src/Hapstone/Internal/Evm.chs new file mode 100644 index 0000000..0c86079 --- /dev/null +++ b/src/Hapstone/Internal/Evm.chs @@ -0,0 +1,56 @@ +{-# LANGUAGE ForeignFunctionInterface #-} +{-| +Module : Hapstone.Internal.Evm +Description : EVM architecture header ported using C2HS + some boilerplate +Copyright : (c) Khoa Nguyen Anh, 2020 +License : BSD3 +Maintainer : Khoa Nguyen Anh +Stability : experimental + +This module contains EVM specific datatypes and their respective Storable +instances. Most of the types are used internally and can be looked up here. +Some of them are currently unused, as the headers only define them as symbolic +constants whose type is never used explicitly, which poses a problem for a +memory-safe port to the Haskell language, this is about to get fixed in a +future version. + +Apart from that, because the module is generated using C2HS, some of the +documentation is misplaced or rendered incorrectly, so if in doubt, read the +source file. +-} +module Hapstone.Internal.Evm where + +#include + +{#context lib = "capstone"#} + +import Data.Maybe (fromMaybe) +import Foreign +import Foreign.C.Types + +import Hapstone.Internal.Util + +data CsEvm = CsEvm + { pop :: Word8 + , push :: Word8 + , fee :: Word32 + } deriving (Show, Eq) + +instance Storable CsEvm where + sizeOf _ = {#sizeof cs_evm#} + alignment _ = {#alignof cs_evm#} + peek p = CsEvm + <$> (fromIntegral <$> {#get cs_evm->pop#} p) + <*> (fromIntegral <$> {#get cs_evm->push#} p) + <*> (fromIntegral <$> {#get cs_evm->fee#} p) + poke p (CsEvm pop push fee) = do + {#set cs_evm->pop#} p (fromIntegral pop) + {#set cs_evm->push#} p (fromIntegral push) + {#set cs_evm->fee#} p (fromIntegral fee) + +-- | EVM instruction +{#enum evm_insn as EvmInsn {underscoreToCase} + deriving (Show, Eq, Bounded)#} +-- | EVM instruction group +{#enum evm_insn_group as EvmInsnGroup {underscoreToCase} + deriving (Show, Eq, Bounded)#} diff --git a/src/Hapstone/Internal/M680x.chs b/src/Hapstone/Internal/M680x.chs new file mode 100644 index 0000000..73f9fb2 --- /dev/null +++ b/src/Hapstone/Internal/M680x.chs @@ -0,0 +1,193 @@ +{-# LANGUAGE ForeignFunctionInterface #-} +{-| +Module : Hapstone.Internal.M680x +Description : M680x architecture header ported using C2HS + some boilerplate +Copyright : (c) Khoa Nguyen Anh, 2020 +License : BSD3 +Maintainer : Khoa Nguyen Anh +Stability : experimental + +This module contains M680X specific datatypes and their respective Storable +instances. Most of the types are used internally and can be looked up here. +Some of them are currently unused, as the headers only define them as symbolic +constants whose type is never used explicitly, which poses a problem for a +memory-safe port to the Haskell language, this is about to get fixed in a +future version. + +Apart from that, because the module is generated using C2HS, some of the +documentation is misplaced or rendered incorrectly, so if in doubt, read the +source file. +-} +module Hapstone.Internal.M680x where + +#include + +{#context lib = "capstone"#} + +import Data.Maybe (fromMaybe) +import Foreign +import Foreign.C.Types + +import Hapstone.Internal.Util + +{#enum m680x_reg as M680xReg {underscoreToCase} + deriving (Show, Eq, Bounded)#} + +data M680xOpIdx = M680xOpIdx + { baseReg :: M680xReg + , offsetReg :: M680xReg + , offset :: Int16 + , offsetAddr :: Int16 + , offsetBits :: Word8 + , incDec :: Int8 + , flags :: Word8 + } deriving (Show, Eq) + +instance Storable M680xOpIdx where + sizeOf _ = {#sizeof m680x_op_idx#} + alignment _ = {#alignof m680x_op_idx#} + peek p = M680xOpIdx + <$> ((toEnum . fromIntegral) <$> {#get m680x_op_idx->base_reg#} p) + <*> ((toEnum . fromIntegral) <$> {#get m680x_op_idx->offset_reg#} p) + <*> (fromIntegral <$> {#get m680x_op_idx->offset#} p) + <*> (fromIntegral <$> {#get m680x_op_idx->offset_addr#} p) + <*> (fromIntegral <$> {#get m680x_op_idx->offset_bits#} p) + <*> (fromIntegral <$> {#get m680x_op_idx->inc_dec#} p) + <*> (fromIntegral <$> {#get m680x_op_idx->flags#} p) + poke p (M680xOpIdx br or o oa ob id f) = do + {#set m680x_op_idx->base_reg#} p (fromIntegral $ fromEnum br) + {#set m680x_op_idx->offset_reg#} p (fromIntegral $ fromEnum or) + {#set m680x_op_idx->offset#} p (fromIntegral o) + {#set m680x_op_idx->offset_addr#} p (fromIntegral oa) + {#set m680x_op_idx->offset_bits#} p (fromIntegral ob) + {#set m680x_op_idx->inc_dec#} p (fromIntegral id) + {#set m680x_op_idx->flags#} p (fromIntegral f) + +data M680xOpRel = M680xOpRel + { address :: Word16 + , offset :: Int16 + } deriving (Show, Eq) + +instance Storable M680xOpRel where + sizeOf _ = {#sizeof m680x_op_rel#} + alignment _ = {#alignof m680x_op_rel#} + peek p = M680xOpRel + <$> (fromIntegral <$> {#get m680x_op_rel->address#} p) + <*> (fromIntegral <$> {#get m680x_op_rel->offset#} p) + poke p (M680xOpRel a o) = do + {#set m680x_op_rel->address#} p (fromIntegral a) + {#set m680x_op_rel->offset#} p (fromIntegral o) + +data M680xOpExt = M680xOpExt + { address :: Word16 + , indirect :: Bool + } deriving (Show, Eq) + +instance Storable M680xOpExt where + sizeOf _ = {#sizeof m680x_op_ext#} + alignment _ = {#alignof m680x_op_ext#} + peek p = M680xOpExt + <$> (fromIntegral <$> {#get m680x_op_ext->address#} p) + <*> (fromIntegral <$> {#get m680x_op_ext->indirect#} p) + poke p (M680xOpExt a i) = do + {#set m680x_op_ext->address#} p (fromIntegral a) + {#set m680x_op_ext->indirect#} p (fromIntegral o) + +data CsM680xOpValue + = Imm Int32 + | Reg M680xReg + | Idx M680xOpIdx + | Rel M680xOpRel + | Ext M680xOpExt + | Addr Word8 + | Val Word8 + | CsM680xOpInvalid + deriving (Show, Eq) + +data CsM680xOp = CsM680xOp + { value :: CsM680xOpValue + , size :: Word8 + , access :: Word8 + } deriving (Show, Eq) + +instance Storable CsM680xOp where + sizeOf _ = {#sizeof cs_m680x_op#} + alignment _ = {#alignof cs_m680x_op#} + peek p = CsM680xOp + <$> do + t <- fromIntegral <$> {#get cs_m680x_op->type#} p + let idxP = plusPtr p {#offsetof cs_m680x_op->idx#} + let relP = plusPtr p {#offsetof cs_m680x_op->rel#} + let extP = plusPtr p {#offsetof cs_m680x_op->ext#} + case toEnum t of + M680xOpRegister -> (Reg . toEnum . fromIntegral) <$> {#get cs_m680x_op->reg#} p + M680xOpImmediate -> (Imm . fromIntegral) <$> {#get cs_m680x_op->imm#} p + M680xOpIndexed -> Idx <$> peek idxP + M680xOpExtended -> Ext <$> peek extP + M680xOpDirect -> (Addr . fromIntegral) <$> {#get cs_m680x_op->direct_addr#} p + M680xOpRelative -> Rel <$> peek relP + M680xOpConstant -> (Val . fromIntegral) <$> {#get cs_m680x_op->const_val#} p + _ -> return CsM680xOpInvalid + <*> (fromIntegral <$> {#get cs_m680x_op->size#} p) + <*> (fromIntegral <$> {#get cs_m680x_op->access#} p) + poke p (CsM680xOp v s a) = do + {#set cs_m680x_op->size#} p (fromIntegral s) + {#set cs_m680x_op->access#} p (fromIntegral a) + let regP = plusPtr p {#offsetof cs_m680x_op->reg#} + immP = plusPtr p {#offsetof cs_m680x_op->imm#} + idxP = plusPtr p {#offsetof cs_m680x_op->idx#} + relP = plusPtr p {#offsetof cs_m680x_op->rel#} + extP = plusPtr p {#offsetof cs_m680x_op->ext#} + addrP = plusPtr p {#offsetof cs_m680x_op->direct_addr#} + valP = plusPtr p {#offsetof cs_m680x_op->const_val#} + setType = {#set cs_m680x_op->type#} p . fromIntegral . fromEnum + case v of + Imm i -> do + poke immP (fromIntegral r :: CUInt) + setType M680xOpImmediate + Reg r -> do + poke regP (fromIntegral $ fromEnum r :: CUInt) + setType M680xOpRegister + Idx i -> do + poke idxP i + setType M680xOpIndexed + Rel r -> do + poke relP r + setType M680xOpRelative + Ext e -> do + poke extP e + setType M680xOpExtended + Addr a -> do + poke addrP (fromIntegral r :: CUInt) + setType M680xOpDirect + Val v -> do + poke valP (fromIntegral r :: CUInt) + setType M680xConstant + _ -> setType M680xOpInvalid + + +data CsM680x = CsM680x + { flags :: Word8 + , operands :: [CsM680xOp] + } deriving (Show, Eq) + +instance Storable CsM680x where + sizeOf _ = {#sizeof cs_m680x#} + alignment _ = {#alignof cs_m680x#} + peek p = CsM680x + <$> (fromIntegral <$> {#get cs_m680x->flags#} p) + <*> do num <- fromIntegral <$> {#get cs_m680x->op_count#} p + let ptr = plusPtr p {#offsetof cs_m680x->operands#} + peekArray num ptr + poke p (CsM680x f o) = do + {#set cs_m680x->flags#} p (fromIntegral f) + if length o > 9 + then error "operands overflew 9 elements" + else pokeArray (plusPtr p {#offsetof cs_m680x->operands#}) o + +-- | M680X instructions +{#enum m608x_insn as M680xInsn {underscoreToCase} + deriving (Show, Eq, Bounded)#} +-- | M680X instruction groups +{#enum cs_m680x_group as CsM680xGroup {underscoreToCase} + deriving (Show, Eq, Bounded)#} diff --git a/src/Hapstone/Internal/M68k.chs b/src/Hapstone/Internal/M68k.chs new file mode 100644 index 0000000..d5301d4 --- /dev/null +++ b/src/Hapstone/Internal/M68k.chs @@ -0,0 +1,235 @@ +{-# LANGUAGE ForeignFunctionInterface #-} +{-| +Module : Hapstone.Internal.M68k +Description : M68k architecture header ported using C2HS + some boilerplate +Copyright : (c) Khoa Nguyen Anh, 2020 +License : BSD3 +Maintainer : Khoa Nguyen Anh +Stability : experimental + +This module contains M68k specific datatypes and their respective Storable +instances. Most of the types are used internally and can be looked up here. +Some of them are currently unused, as the headers only define them as symbolic +constants whose type is never used explicitly, which poses a problem for a +memory-safe port to the Haskell language, this is about to get fixed in a +future version. + +Apart from that, because the module is generated using C2HS, some of the +documentation is misplaced or rendered incorrectly, so if in doubt, read the +source file. +-} +module Hapstone.Internal.M68k where + +#include + +{#context lib = "capstone"#} + +import Data.Maybe (fromMaybe) +import Foreign +import Foreign.C.Types + +import Hapstone.Internal.Util + +{#enum m68k_reg as M68kReg {underscoreToCase} + deriving (Show, Eq, Bounded)#} + +{#enum m68k_address_mode as M68kAddressMode {underscoreToCase} + deriving (Show, Eq, Bounded)#} + +{#enum m68k_op_type as M68kOpType {underscoreToCase} + deriving (Show, Eq, Bounded)#} + +data M68kOpMem = M68kOpMem + { baseReg :: M68kReg + , indexReg :: M68kReg + , inBaseReg :: M68kReg + , inDisp :: Word32 + , outDisp :: Word32 + , disp :: Int16 + , scale :: Word8 + , bitfield :: Word8 + , width :: Word8 + , offset :: Word8 + , indexSize :: Word8 + } deriving (Show, Eq) + +instance Storable M68kOpMem where + sizeOf _ = {#sizeof m68k_op_mem#} + alignment _ = {#alignof m68k_op_mem#} + peek p = M68kOpMem + <$> ((toEnum . fromIntegral) <$> {#get m68k_op_mem->baseReg#} p) + <*> ((toEnum . fromIntegral) <$> {#get m68k_op_mem->indexReg#} p) + <*> ((toEnum . fromIntegral) <$> {#get m68k_op_mem->inBaseReg#} p) + <*> (fromIntegral <$> {#get m68k_op_mem->inDisp#} p) + <*> (fromIntegral <$> {#get m68k_op_mem->outDisp#} p) + <*> (fromIntegral <$> {#get m68k_op_mem->disp#} p) + <*> (fromIntegral <$> {#get m68k_op_mem->scale#} p) + <*> (fromIntegral <$> {#get m68k_op_mem->bitfield#} p) + <*> (fromIntegral <$> {#get m68k_op_mem->width#} p) + <*> (fromIntegral <$> {#get m68k_op_mem->offset#} p) + <*> (fromIntegral <$> {#get m68k_op_mem->indexSize#} p) + poke p (M68kOpMem bR iR iBR iD oD d s b w o iS) = do + {#set m68k_op_mem->baseReg#} p (fromIntegral $ fromEnum bR) + {#set m68k_op_mem->indexReg#} p (fromIntegral $ fromEnum iR) + {#set m68k_op_mem->inBaseReg#} p (fromIntegral $ fromEnum iBR) + {#set m68k_op_mem->inDisp#} p (fromIntegral iD) + {#set m68k_op_mem->outDisp#} p (fromIntegral oD) + {#set m68k_op_mem->disp#} p (fromIntegral d) + {#set m68k_op_mem->scale#} p (fromIntegral s) + {#set m68k_op_mem->bitfield#} p (fromIntegral b) + {#set m68k_op_mem->width#} p (fromIntegral w) + {#set m68k_op_mem->offset#} p (fromIntegral o) + {#set m68k_op_mem->indexSize#} p (fromIntegral iS) + + +{#enum m68k_op_br_disp_size as M68kOpBrDispSize {underscoreToCase} + deriving (Show, Eq, Bounded)#} + +data M68kOpBrDisp = M68kOpBrDisp + { disp :: Int32 + , size :: M68kOpBrDispSize + } deriving (Show, Eq) + +instance Storable M68kOpBrDisp where + sizeOf _ = {#sizeof m68k_op_br_disp#} + alignment _ = {#alignof m68k_op_br_disp#} + peek p = M68kOpBrDisp + <$> (fromIntegral <$> {#get m68k_op_br_disp->disp#} p) + <*> ((toEnum . fromIntegral) <$> {#get m68k_op_br_disp->size#} p) + poke p (M68kOpBrDisp d s) = do + {#set m68k_op_br_disp->disp#} p (fromIntegral d) + {#set m68k_op_br_disp->size#} p (fromIntegral $ fromEnum s) + + +data CsM68kOpValue + = Imm Word64 + | DImm Double + | SImm Float + | Reg M68kReg + | RegPair (M68kReg, M68kReg) + | Undefined + deriving (Show, Eq) + +data CsM68kOp = CsM68kOp + { mem :: M68kOpMem + , brDisp :: M68kOpBrDisp + , registerBits :: Word32 + , value :: CsM68kOpValue + , addressMode :: M68kAddressMode + } deriving (Show, Eq) + +instance Storable CsM68kOp where + sizeOf _ = {#sizeof cs_m68k_op#} + alignment _ = {#alignof cs_m68k_op#} + peek p = CsM68kOp + <$> do + t <- fromIntegral <$> {#get cs_m68k_op->type#} p + let regP = plusPtr p {#offsetof cs_m68k_op->reg#} + let reg0P = plusPtr p {#offsetof cs_m68k_op->reg_0#} + let reg1P = plusPtr p {#offsetof cs_m68k_op->reg_1#} + case toEnum t of + M68kOpImm -> (Imm. toEnum . fromIntegral) <$> {#get cs_m68k_op->imm#} p + M68kOpFpDouble -> (Reg . toEnum . fromIntegral) <$> {#get cs_m68k_op->dimm#} p + M68kOpFpSingle -> (Reg . toEnum . fromIntegral) <$> {#get cs_m68k_op->simm#} p + M68OpReg -> Reg <$> (peek regP) + M68OpRegPair -> (,) + <$> (Reg <$> (peek reg0P)) + <*> (Reg <$> (peek reg1P)) + <*> peek (plusPtr p {#offsetof cs_m68k_op->br_disp#}) + <*> (fromIntegral <$> {#get cs_m68k_op->registerBits#} p) + <*> ((toEnum . fromIntegral) <$> {#get cs_m64k_op->value#} p) + <*> ((toEnum . fromIntegral) <$> {#get cs_m64k_op->addressMode#} p) + poke p (CsM68kOp m b r v a) = do + poke (plusPtr p {#offsetof cs_m68k_op->br_disp#}) b + {#set cs_m68k_op->value#} p (fromIntegral $ fromEnum v) + {#set cs_m68k_op->addressMode#} p (fromIntegral $ fromEnum a) + {#set cs_m68k_op->registerBits#} p (fromIntegral r) + let regP = plusPtr p {#offsetof cs_m68k_op->reg#} + immP = plusPtr p {#offsetof cs_m68k_op->imm#} + dimmP = plusPtr p {#offsetof cs_m68k_op->dimm#} + simmP = plusPtr p {#offsetof cs_m68k_op->simm#} + reg0P = plusPtr p {#offsetof cs_m68k_op->reg_0#} + reg1P = plusPtr p {#offsetof cs_m68k_op->reg_1#} + setType = {#set cs_m68k_op->type#} p . fromIntegral . fromEnum + case m of + Reg r -> do + poke regP (fromIntegral $ fromEnum r :: CUInt) + setType M68kOpReg + Imm i -> do + poke immP (fromIntegral i :: Int64) + setType M68kOpImm + DImm i -> do + poke dimmP (fromIntegral i :: Int64) + setType M68kOpFpDouble + SImm i -> do + poke simmP (fromIntegral i :: Int64) + setType M68kOpFpSingle + RegPair (r0, r1) -> do + poke reg0P (fromIntegral $ fromEnum r0 :: CUInt) + poke reg1P (fromIntegral $ fromEnum r1 :: CUInt) + setType M68kOpRegPair + _ -> setType M68kOpInvalid + +{#enum m68k_cpu_size as M68kCpuSize {underscoreToCase} + deriving (Show, Eq, Bounded)#} + +{#enum m68k_fpu_size as M68kFpuSize {underscoreToCase} + deriving (Show, Eq, Bounded)#} + +{#enum m68k_size_type as M68kSizeType {underscoreToCase} + deriving (Show, Eq, Bounded)#} + +data M68kOpSize + = CpuSize M68kCpuSize + | FpuSize M68kCpuSize + | M68kOpSizeInvalid + deriving (Show, Eq) + +instance Storable M68kOpSize where + sizeOf _ = {#sizeof m68k_op_size#} + alignment _ = {#alignof m68k_op_size#} + peek p = do + t <- fromIntegral <$> {#get m68k_op_size->type#} p + case toEnum t of + M68kSizeTypeCpu -> (CpuSize . toEnum . fromIntegral) <$> {#get m68k_op_size->cpu_size#} p + M68KSizeTypeFpu -> (FpuSize . toEnum . fromIntegral) <$> {#get m68k_op_size->fpu_size#} p + _ -> M68kOpSizeInvalid + poke p opSize = do + let cpuP = plusPtr p {#offsetof m68_op_size->cpu_size#} + fpuP = plusPtr p {#offsetof m68_op_size->fpu_size#} + setType = {#set m68_op_size->type#} p . fromIntegral . fromEnum + case opSize of + CpuSize c -> do + poke cpuP (fromIntegral $ fromEnum c :: CUInt) + setType M68kSizeTypeCpu + FpuSize f -> do + poke fpuP (fromIntegral $ fromEnum f :: CUInt) + setType M68kSizeTypeFpu + _ -> setType M68kSizeInvalid + + +data CsM68k = CsM68k + { operands :: [CsM68kOp] + , size :: M68kOpSize + } deriving (Show, Eq) + +instance Storable CsM68k where + sizeOf _ = {#sizeof cs_m68k#} + alignment _ = {#alignof cs_m68k#} + peek p = CsM68k + <$> do num <- fromIntegral <$> {#get cs_m68k->op_count#} p + let ptr = plusPtr p {#offsetof cs_m68k->operands#} + peekArray num ptr + <*> peek (plusPtr p {#offsetof cs_m68k->op_size#}) + poke p (CsM68k o s) = do + poke (plusPtr p {#offsetof cs_m68k-op_size>#}) s + {#set cs_m68k->op_count#} p (fromIntegral $ length o) + if length o > 4 + then error "operands overflew 4 elements" + else pokeArray (plusPtr p {#offsetof cs_m68k->operands#}) o + +{#enum m68k_insn as M68kInsn {underscoreToCase} + deriving (Show, Eq, Bounded)#} + +{#enum m68k_group_type as M68kGroupType {underscoreToCase} + deriving (Show, Eq, Bounded)#} diff --git a/src/Hapstone/Internal/Tms320c64x.chs b/src/Hapstone/Internal/Tms320c64x.chs new file mode 100644 index 0000000..c2bc518 --- /dev/null +++ b/src/Hapstone/Internal/Tms320c64x.chs @@ -0,0 +1,164 @@ +{-# LANGUAGE ForeignFunctionInterface #-} +{-| +Module : Hapstone.Internal.Tms320c64x +Description : Tms320c64x architecture header ported using C2HS + some boilerplate +Copyright : (c) Khoa Nguyen Anh, 2020 +License : BSD3 +Maintainer : Khoa Nguyen Anh +Stability : experimental + +This module contains Tms320c64x specific datatypes and their respective Storable +instances. Most of the types are used internally and can be looked up here. +Some of them are currently unused, as the headers only define them as symbolic +constants whose type is never used explicitly, which poses a problem for a +memory-safe port to the Haskell language, this is about to get fixed in a +future version. + +Apart from that, because the module is generated using C2HS, some of the +documentation is misplaced or rendered incorrectly, so if in doubt, read the +source file. +-} +module Hapstone.Internal.Tms320c64x where + +#include + +{#context lib = "capstone"#} + +import Data.Maybe (fromMaybe) +import Foreign +import Foreign.C.Types + +import Hapstone.Internal.Util + +{#enum tms320c64x_op_type as Tms320c64xOpType {underscoreToCase} + deriving (Show, Eq, Bounded)#} + +{#enum tms320c64x_mem_disp as Tms320c64xMemDisp {underscoreToCase} + deriving (Show, Eq, Bounded)#} + +{#enum tms320c64x_mem_dir as Tms320c64xMemDir {underscoreToCase} + deriving (Show, Eq, Bounded)#} + +{#enum tms320c64x_mem_mod as Tms320c64xMemMod {underscoreToCase} + deriving (Show, Eq, Bounded)#} + +data Tms320c64xOpMem = Tms320c64xOpMem + { base :: Word32 + , disp :: Word32 + , uint :: Word32 + , scaled :: Word32 + , disptype :: Word32 + , direction :: Word32 + , modify :: Word32 + } deriving (Show, Eq) + +instance Storable Tms320c64xOpMem where + sizeOf _ = {#sizeof tms320c64x_op_mem#} + alignment _ = {#alignof tms320c64x_op_mem#} + peek p = Tms320c64xOpMem + <$> (fromIntegral <$> {#get tms320c64x_op_mem->base#} p) + <*> (fromIntegral <$> {#get tms320c64x_op_mem->disp#} p) + <*> (fromIntegral <$> {#get tms320c64x_op_mem->uint#} p) + <*> (fromIntegral <$> {#get tms320c64x_op_mem->scaled#} p) + <*> (fromIntegral <$> {#get tms320c64x_op_mem->disptype#} p) + <*> (fromIntegral <$> {#get tms320c64x_op_mem->direction#} p) + <*> (fromIntegral <$> {#get tms320c64x_op_mem->modify#} p) + poke p (Tms320c64xOpMem b d u s dt dr m) = do + {#set tms320c64x_op_mem->base#} p (fromIntegral b) + {#set tms320c64x_op_mem->disp#} p (fromIntegral d) + {#set tms320c64x_op_mem->uint#} p (fromIntegral u) + {#set tms320c64x_op_mem->scaled#} p (fromIntegral s) + {#set tms320c64x_op_mem->disptype#} p (fromIntegral dt) + {#set tms320c64x_op_mem->direction#} p (fromIntegral dr) + {#set tms320c64x_op_mem->modify#} p (fromIntegral m) + +data CsTms320c64xOpValue + = Imm Int32 + | Reg Word32 + | RegPair Word32 + | Mem Tms320c64xOpMem + | CsTms320c64xOpInvalid + deriving (Show, Eq) + +data CsTms320c64xOp = CsTms320c64xOp + { value :: CsTms320c64xOpValue + } deriving (Show, Eq) + +instance Storable CsTms320c64xOp where + sizeOf _ = {#sizeof cs_tms320c64x_op#} + alignment _ = {#alignof cs_tms320c64x_op#} + peek p = CsTms320c64xOp + <$> do + t <- fromIntegral <$> {#get cs_tms320c64x_op->type#} p + let memP = plusPtr p {#offsetof cs_tms320c64x_op->mem#} + case toEnum t of + Tms320c64xOpReg -> (Reg . fromIntegral) <$> {#get cs_tms320c64x_op->reg#} p + Tms320c64xOpRegpair -> (RegPair . fromIntegral) <$> {#get cs_tms320c64x_op->reg#} p + Tms320c64xOpImm -> (Imm . fromIntegral) <$> {#get cs_tms320c64x_op->reg#} p + Tms320c64xOpMem -> Mem <$> peek memP + _ -> return CsTms320c64xOpInvalid + poke p (CsTms320c64xOp v) = do + let regP = plusPtr p {#offsetof cs_tms320c64x_op->reg#} + immP = plusPtr p {#offsetof cs_tms320c64x_op->imm#} + memP = plusPtr p {#offsetof cs_tms320c64x_op->mem#} + setType = {#set cs_tms320c64x_op->type#} p . fromIntegral . fromEnum + case op of + Reg r -> do + poke regP (fromIntegral r :: CUInt) + setType Tms320c64xOpReg + RegPair r -> do + poke regP (fromIntegral r :: CUInt) + setType Tms320c64xOpRegpair + Imm i -> do + poke immP i + setType Tms320c64xOpImm + Mem m -> do + poke memP m + setType Tms320c64xOpMem + _ -> setType Tms320c64xOpInvalid + +data CsTms320c64x = CsTms320c64x + { operands :: [CsTms320c64xOp] + , condition :: (Word32, Word32) + , funit :: (Word32, Word32, Word32) + , parallel :: Word32 + } deriving (Show, Eq) + +instance Storable CsTms320c64x where + sizeOf _ = {#sizeof cs_tms320c64x#} + alignment _ = {#alignof cs_tms320c64x#} + peek p = CsTms320c64x + <$> do num <- fromIntegral <$> {#get cs_tms320c64x->op_count#} p + let ptr = plusPtr p {#offsetof cs_tms320c64x->operands#} + peekArray num ptr + <*> (,) + <$> fromIntegral <$> {#get cs_tms320c64x->condition.reg#} p + <*> fromIntegral <$> {#get cs_tms320c64x->condition.zero#} p + <*> (,,) + <$> fromIntegral <$> {#get cs_tms320c64x->funit.unit#} p + <*> fromIntegral <$> {#get cs_tms320c64x->funit.side#} p + <*> fromIntegral <$> {#get cs_tms320c64x->funit.crosspath#} p + <*> fromIntegral <$> {#get cs_tms320c64x->parallel#} p + poke p (CsTms320c64x o (r, z) (u, s, c) p) = do + {#set cs_tms320c64x->condition.reg#} p (fromIntegral r) + {#set cs_tms320c64x->condition.zero#} p (fromIntegral z) + {#set cs_tms320c64x->funit.unit#} p (fromIntegral u) + {#set cs_tms320c64x->funit.side#} p (fromIntegral s) + {#set cs_tms320c64x->funit.crosspath#} p (fromIntegral c) + {#set cs_tms320c64x->parallel#} p (fromIntegral p) + {#set cs_tms320c64x->op_count#} p (fromIntegral $ length o) + if length o > 8 + then error "operands overflew 8 elements" + else pokeArray (plusPtr p {#offsetof cs_tms320c64x->operands#}) o + +{#enum tms320c64x_reg as Tms320c64xReg {underscoreToCase} + deriving (Show, Eq, Bounded)#} + +{#enum tms320c64x_insn as Tms320c64xInsn {underscoreToCase} + deriving (Show, Eq, Bounded)#} + +{#enum tms320c64x_group_type as Tms320c64xGroupType {underscoreToCase} + deriving (Show, Eq, Bounded)#} + +{#enum tms320c64x_funit as Tms320c64xFunit {underscoreToCase} + deriving (Show, Eq, Bounded)#} From 0546ba351d3ece3bcc753ce1355a7f0dc0fc01b7 Mon Sep 17 00:00:00 2001 From: nganhkhoa Date: Mon, 1 Jun 2020 11:44:57 +0000 Subject: [PATCH 03/21] fix mips operand size error message --- src/Hapstone/Internal/Mips.chs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Hapstone/Internal/Mips.chs b/src/Hapstone/Internal/Mips.chs index 84da606..56847f8 100644 --- a/src/Hapstone/Internal/Mips.chs +++ b/src/Hapstone/Internal/Mips.chs @@ -106,7 +106,7 @@ instance Storable CsMips where poke p (CsMips o) = do {#set cs_mips->op_count#} p (fromIntegral $ length o) if length o > 10 - then error "operands overflew 8 elements" + then error "operands overflew 10 elements" else pokeArray (plusPtr p {#offsetof cs_mips->operands#}) o -- | MIPS instructions From 4b9a0db83e2bd7398d8620a53eef893e828c25b8 Mon Sep 17 00:00:00 2001 From: nganhkhoa Date: Mon, 1 Jun 2020 13:26:49 +0000 Subject: [PATCH 04/21] Fix compilation issues The bootstraped code cannot compile, add modules to hapstone.cabal Fix compilation failures --- hapstone.cabal | 14 +++- src/Hapstone/Internal/Capstone.chs | 29 ++++--- src/Hapstone/Internal/M680x.chs | 30 +++---- src/Hapstone/Internal/M68k.chs | 116 ++++++++++++++------------- src/Hapstone/Internal/Tms320c64x.chs | 40 ++++----- 5 files changed, 123 insertions(+), 106 deletions(-) diff --git a/hapstone.cabal b/hapstone.cabal index b2b7374..fdd2cd8 100644 --- a/hapstone.cabal +++ b/hapstone.cabal @@ -24,7 +24,11 @@ library Hapstone.Internal.Sparc, Hapstone.Internal.SystemZ, Hapstone.Internal.X86, - Hapstone.Internal.XCore + Hapstone.Internal.XCore, + Hapstone.Internal.Evm, + Hapstone.Internal.M680x, + Hapstone.Internal.M68k, + Hapstone.Internal.Tms320c64x build-depends: base >= 4.7 && < 5 default-language: Haskell2010 extra-libraries: capstone @@ -52,6 +56,14 @@ test-suite hapstone-test Internal.X86.Default, Internal.XCore.StorableSpec, Internal.XCore.Default, + Internal.Evm.StorableSpec, + Internal.Evm.Default, + Internal.M680x.StorableSpec, + Internal.M680x.Default, + Internal.M68k.StorableSpec, + Internal.M68k.Default, + Internal.Tms320c64x.StorableSpec, + Internal.Tms320c64x.Default, Internal.CapstoneSpec, Internal.Default build-depends: base, diff --git a/src/Hapstone/Internal/Capstone.chs b/src/Hapstone/Internal/Capstone.chs index a9ea7e1..a5fd1c7 100644 --- a/src/Hapstone/Internal/Capstone.chs +++ b/src/Hapstone/Internal/Capstone.chs @@ -88,6 +88,10 @@ import qualified Hapstone.Internal.Sparc as Sparc import qualified Hapstone.Internal.SystemZ as SystemZ import qualified Hapstone.Internal.X86 as X86 import qualified Hapstone.Internal.XCore as XCore +import qualified Hapstone.Internal.M68k as M68k +import qualified Hapstone.Internal.Tms320c64x as Tms320c64x +import qualified Hapstone.Internal.Evm as Evm +import qualified Hapstone.Internal.M680x as M680x import System.IO.Unsafe (unsafePerformIO) @@ -169,15 +173,15 @@ data ArchInfo = X86 X86.CsX86 -- ^ x86 architecture | Arm64 Arm64.CsArm64 -- ^ ARM64 architecture | Arm Arm.CsArm -- ^ ARM architecture - -- | M68k M68k.CsM68k -- ^ M68K architecture + | M68k M68k.CsM68k -- ^ M68K architecture | Mips Mips.CsMips -- ^ MIPS architecture | Ppc Ppc.CsPpc -- ^ PPC architecture | Sparc Sparc.CsSparc -- ^ SPARC architecture | SysZ SystemZ.CsSysZ -- ^ SystemZ architecture | XCore XCore.CsXCore -- ^ XCore architecture - -- | Tms320c64x Tms320c64x.CsTms320c64x -- ^ TMS320C64x architecture - -- | M680x M680x.CsM680x -- ^ M680X architecture - -- | Evm Evm.CsEvm -- ^ Ethereum architecture + | Tms320c64x Tms320c64x.CsTms320c64x -- ^ TMS320C64x architecture + | M680x M680x.CsM680x -- ^ M680X architecture + | Evm Evm.CsEvm -- ^ Ethereum architecture deriving (Show, Eq) -- | instruction information @@ -227,15 +231,15 @@ instance Storable CsDetail where Just (X86 x) -> poke bP x Just (Arm64 x) -> poke bP x Just (Arm x) -> poke bP x - -- Just (M68k x) -> poke bP x + Just (M68k x) -> poke bP x Just (Mips x) -> poke bP x Just (Ppc x) -> poke bP x Just (Sparc x) -> poke bP x Just (SysZ x) -> poke bP x Just (XCore x) -> poke bP x - -- Just (Tms320c64x x) -> poke bP x - -- Just (M680x x) -> poke bP x - -- Just (Evm x) -> poke bP x + Just (Tms320c64x x) -> poke bP x + Just (M680x x) -> poke bP x + Just (Evm x) -> poke bP x Nothing -> return () -- | an arch-sensitive peek for cs_detail @@ -252,11 +256,10 @@ peekDetail arch p = do CsArchSparc -> Sparc <$> peek bP CsArchSysz -> SysZ <$> peek bP CsArchXcore -> XCore <$> peek bP - -- CsArchM68k -> M68k <$> peek bP - -- CsArchTms320C64x -> Tms320c64x <$> peek bP - -- CsArchM680x -> M680x <$> peek bP - -- CsArchEvm -> Evm <$> peek bP - -- CsArchMax -> Max <$> peek bP + CsArchM68k -> M68k <$> peek bP + CsArchTms320c64x -> Tms320c64x <$> peek bP + CsArchM680x -> M680x <$> peek bP + CsArchEvm -> Evm <$> peek bP return detail { archInfo = Just aI } -- | instructions diff --git a/src/Hapstone/Internal/M680x.chs b/src/Hapstone/Internal/M680x.chs index 73f9fb2..dbfe297 100644 --- a/src/Hapstone/Internal/M680x.chs +++ b/src/Hapstone/Internal/M680x.chs @@ -33,14 +33,17 @@ import Hapstone.Internal.Util {#enum m680x_reg as M680xReg {underscoreToCase} deriving (Show, Eq, Bounded)#} +{#enum m680x_op_type as M680xOpType {underscoreToCase} + deriving (Show, Eq, Bounded)#} + data M680xOpIdx = M680xOpIdx { baseReg :: M680xReg , offsetReg :: M680xReg - , offset :: Int16 + , idxOffset :: Int16 , offsetAddr :: Int16 , offsetBits :: Word8 , incDec :: Int8 - , flags :: Word8 + , idxFlags :: Word8 } deriving (Show, Eq) instance Storable M680xOpIdx where @@ -64,8 +67,8 @@ instance Storable M680xOpIdx where {#set m680x_op_idx->flags#} p (fromIntegral f) data M680xOpRel = M680xOpRel - { address :: Word16 - , offset :: Int16 + { relAddress :: Word16 + , relOffset :: Int16 } deriving (Show, Eq) instance Storable M680xOpRel where @@ -79,7 +82,7 @@ instance Storable M680xOpRel where {#set m680x_op_rel->offset#} p (fromIntegral o) data M680xOpExt = M680xOpExt - { address :: Word16 + { extAddress :: Word16 , indirect :: Bool } deriving (Show, Eq) @@ -88,10 +91,10 @@ instance Storable M680xOpExt where alignment _ = {#alignof m680x_op_ext#} peek p = M680xOpExt <$> (fromIntegral <$> {#get m680x_op_ext->address#} p) - <*> (fromIntegral <$> {#get m680x_op_ext->indirect#} p) + <*> ({#get m680x_op_ext->indirect#} p) poke p (M680xOpExt a i) = do {#set m680x_op_ext->address#} p (fromIntegral a) - {#set m680x_op_ext->indirect#} p (fromIntegral o) + {#set m680x_op_ext->indirect#} p i data CsM680xOpValue = Imm Int32 @@ -143,7 +146,7 @@ instance Storable CsM680xOp where setType = {#set cs_m680x_op->type#} p . fromIntegral . fromEnum case v of Imm i -> do - poke immP (fromIntegral r :: CUInt) + poke immP (fromIntegral i :: CUInt) setType M680xOpImmediate Reg r -> do poke regP (fromIntegral $ fromEnum r :: CUInt) @@ -158,11 +161,11 @@ instance Storable CsM680xOp where poke extP e setType M680xOpExtended Addr a -> do - poke addrP (fromIntegral r :: CUInt) + poke addrP (fromIntegral a :: CUInt) setType M680xOpDirect Val v -> do - poke valP (fromIntegral r :: CUInt) - setType M680xConstant + poke valP (fromIntegral a :: CUInt) + setType M680xOpConstant _ -> setType M680xOpInvalid @@ -186,8 +189,5 @@ instance Storable CsM680x where else pokeArray (plusPtr p {#offsetof cs_m680x->operands#}) o -- | M680X instructions -{#enum m608x_insn as M680xInsn {underscoreToCase} - deriving (Show, Eq, Bounded)#} --- | M680X instruction groups -{#enum cs_m680x_group as CsM680xGroup {underscoreToCase} +{#enum m680x_insn as M680xInsn {underscoreToCase} deriving (Show, Eq, Bounded)#} diff --git a/src/Hapstone/Internal/M68k.chs b/src/Hapstone/Internal/M68k.chs index d5301d4..b96ff81 100644 --- a/src/Hapstone/Internal/M68k.chs +++ b/src/Hapstone/Internal/M68k.chs @@ -39,13 +39,13 @@ import Hapstone.Internal.Util {#enum m68k_op_type as M68kOpType {underscoreToCase} deriving (Show, Eq, Bounded)#} -data M68kOpMem = M68kOpMem +data M68kOpMemStruct = M68kOpMemStruct { baseReg :: M68kReg , indexReg :: M68kReg , inBaseReg :: M68kReg , inDisp :: Word32 , outDisp :: Word32 - , disp :: Int16 + , memDisp :: Int16 , scale :: Word8 , bitfield :: Word8 , width :: Word8 @@ -53,52 +53,52 @@ data M68kOpMem = M68kOpMem , indexSize :: Word8 } deriving (Show, Eq) -instance Storable M68kOpMem where +instance Storable M68kOpMemStruct where sizeOf _ = {#sizeof m68k_op_mem#} alignment _ = {#alignof m68k_op_mem#} - peek p = M68kOpMem - <$> ((toEnum . fromIntegral) <$> {#get m68k_op_mem->baseReg#} p) - <*> ((toEnum . fromIntegral) <$> {#get m68k_op_mem->indexReg#} p) - <*> ((toEnum . fromIntegral) <$> {#get m68k_op_mem->inBaseReg#} p) - <*> (fromIntegral <$> {#get m68k_op_mem->inDisp#} p) - <*> (fromIntegral <$> {#get m68k_op_mem->outDisp#} p) + peek p = M68kOpMemStruct + <$> ((toEnum . fromIntegral) <$> {#get m68k_op_mem->base_reg#} p) + <*> ((toEnum . fromIntegral) <$> {#get m68k_op_mem->index_reg#} p) + <*> ((toEnum . fromIntegral) <$> {#get m68k_op_mem->in_base_reg#} p) + <*> (fromIntegral <$> {#get m68k_op_mem->in_disp#} p) + <*> (fromIntegral <$> {#get m68k_op_mem->out_disp#} p) <*> (fromIntegral <$> {#get m68k_op_mem->disp#} p) <*> (fromIntegral <$> {#get m68k_op_mem->scale#} p) <*> (fromIntegral <$> {#get m68k_op_mem->bitfield#} p) <*> (fromIntegral <$> {#get m68k_op_mem->width#} p) <*> (fromIntegral <$> {#get m68k_op_mem->offset#} p) - <*> (fromIntegral <$> {#get m68k_op_mem->indexSize#} p) - poke p (M68kOpMem bR iR iBR iD oD d s b w o iS) = do - {#set m68k_op_mem->baseReg#} p (fromIntegral $ fromEnum bR) - {#set m68k_op_mem->indexReg#} p (fromIntegral $ fromEnum iR) - {#set m68k_op_mem->inBaseReg#} p (fromIntegral $ fromEnum iBR) - {#set m68k_op_mem->inDisp#} p (fromIntegral iD) - {#set m68k_op_mem->outDisp#} p (fromIntegral oD) + <*> (fromIntegral <$> {#get m68k_op_mem->index_size#} p) + poke p (M68kOpMemStruct bR iR iBR iD oD d s b w o iS) = do + {#set m68k_op_mem->base_reg#} p (fromIntegral $ fromEnum bR) + {#set m68k_op_mem->index_reg#} p (fromIntegral $ fromEnum iR) + {#set m68k_op_mem->in_base_reg#} p (fromIntegral $ fromEnum iBR) + {#set m68k_op_mem->in_disp#} p (fromIntegral iD) + {#set m68k_op_mem->out_disp#} p (fromIntegral oD) {#set m68k_op_mem->disp#} p (fromIntegral d) {#set m68k_op_mem->scale#} p (fromIntegral s) {#set m68k_op_mem->bitfield#} p (fromIntegral b) {#set m68k_op_mem->width#} p (fromIntegral w) {#set m68k_op_mem->offset#} p (fromIntegral o) - {#set m68k_op_mem->indexSize#} p (fromIntegral iS) + {#set m68k_op_mem->index_size#} p (fromIntegral iS) {#enum m68k_op_br_disp_size as M68kOpBrDispSize {underscoreToCase} deriving (Show, Eq, Bounded)#} -data M68kOpBrDisp = M68kOpBrDisp - { disp :: Int32 - , size :: M68kOpBrDispSize +data M68kOpBrDispStruct = M68kOpBrDispStruct + { brDisp :: Int32 + , brSize :: M68kOpBrDispSize } deriving (Show, Eq) -instance Storable M68kOpBrDisp where +instance Storable M68kOpBrDispStruct where sizeOf _ = {#sizeof m68k_op_br_disp#} alignment _ = {#alignof m68k_op_br_disp#} - peek p = M68kOpBrDisp + peek p = M68kOpBrDispStruct <$> (fromIntegral <$> {#get m68k_op_br_disp->disp#} p) - <*> ((toEnum . fromIntegral) <$> {#get m68k_op_br_disp->size#} p) - poke p (M68kOpBrDisp d s) = do + <*> ((toEnum . fromIntegral) <$> {#get m68k_op_br_disp->disp_size#} p) + poke p (M68kOpBrDispStruct d s) = do {#set m68k_op_br_disp->disp#} p (fromIntegral d) - {#set m68k_op_br_disp->size#} p (fromIntegral $ fromEnum s) + {#set m68k_op_br_disp->disp_size#} p (fromIntegral $ fromEnum s) data CsM68kOpValue @@ -107,14 +107,14 @@ data CsM68kOpValue | SImm Float | Reg M68kReg | RegPair (M68kReg, M68kReg) - | Undefined + | CsM68kOpInvalid deriving (Show, Eq) data CsM68kOp = CsM68kOp - { mem :: M68kOpMem - , brDisp :: M68kOpBrDisp + { value :: CsM68kOpValue + , mem :: M68kOpMemStruct + , br :: M68kOpBrDispStruct , registerBits :: Word32 - , value :: CsM68kOpValue , addressMode :: M68kAddressMode } deriving (Show, Eq) @@ -125,33 +125,35 @@ instance Storable CsM68kOp where <$> do t <- fromIntegral <$> {#get cs_m68k_op->type#} p let regP = plusPtr p {#offsetof cs_m68k_op->reg#} - let reg0P = plusPtr p {#offsetof cs_m68k_op->reg_0#} - let reg1P = plusPtr p {#offsetof cs_m68k_op->reg_1#} + let reg0P = plusPtr p {#offsetof cs_m68k_op->reg_pair.reg_0#} + let reg1P = plusPtr p {#offsetof cs_m68k_op->reg_pair.reg_1#} case toEnum t of - M68kOpImm -> (Imm. toEnum . fromIntegral) <$> {#get cs_m68k_op->imm#} p - M68kOpFpDouble -> (Reg . toEnum . fromIntegral) <$> {#get cs_m68k_op->dimm#} p - M68kOpFpSingle -> (Reg . toEnum . fromIntegral) <$> {#get cs_m68k_op->simm#} p - M68OpReg -> Reg <$> (peek regP) - M68OpRegPair -> (,) - <$> (Reg <$> (peek reg0P)) - <*> (Reg <$> (peek reg1P)) + M68kOpImm -> (Imm . fromIntegral) <$> {#get cs_m68k_op->imm#} p + M68kOpFpDouble -> (DImm . realToFrac) <$> {#get cs_m68k_op->dimm#} p + M68kOpFpSingle -> (SImm . realToFrac) <$> {#get cs_m68k_op->simm#} p + M68kOpReg -> (Reg . toEnum . fromIntegral) <$> {#get cs_m68k_op->reg#} p + M68kOpRegPair -> do + let r0 = (toEnum . fromIntegral) <$> {#get cs_m68k_op->reg_pair.reg_0#} p + let r1 = (toEnum . fromIntegral) <$> {#get cs_m68k_op->reg_pair.reg_1#} p + RegPair <$> ((,) <$> r0 <*> r1) + _ -> return CsM68kOpInvalid + <*> peek (plusPtr p {#offsetof cs_m68k_op->mem#}) <*> peek (plusPtr p {#offsetof cs_m68k_op->br_disp#}) - <*> (fromIntegral <$> {#get cs_m68k_op->registerBits#} p) - <*> ((toEnum . fromIntegral) <$> {#get cs_m64k_op->value#} p) - <*> ((toEnum . fromIntegral) <$> {#get cs_m64k_op->addressMode#} p) - poke p (CsM68kOp m b r v a) = do + <*> (fromIntegral <$> {#get cs_m68k_op->register_bits#} p) + <*> ((toEnum . fromIntegral) <$> {#get cs_m68k_op->address_mode#} p) + poke p (CsM68kOp v m b r a) = do + poke (plusPtr p {#offsetof cs_m68k_op->mem#}) m poke (plusPtr p {#offsetof cs_m68k_op->br_disp#}) b - {#set cs_m68k_op->value#} p (fromIntegral $ fromEnum v) - {#set cs_m68k_op->addressMode#} p (fromIntegral $ fromEnum a) - {#set cs_m68k_op->registerBits#} p (fromIntegral r) + {#set cs_m68k_op->address_mode#} p (fromIntegral $ fromEnum a) + {#set cs_m68k_op->register_bits#} p (fromIntegral r) let regP = plusPtr p {#offsetof cs_m68k_op->reg#} immP = plusPtr p {#offsetof cs_m68k_op->imm#} dimmP = plusPtr p {#offsetof cs_m68k_op->dimm#} simmP = plusPtr p {#offsetof cs_m68k_op->simm#} - reg0P = plusPtr p {#offsetof cs_m68k_op->reg_0#} - reg1P = plusPtr p {#offsetof cs_m68k_op->reg_1#} + reg0P = plusPtr p {#offsetof cs_m68k_op->reg_pair.reg_0#} + reg1P = plusPtr p {#offsetof cs_m68k_op->reg_pair.reg_1#} setType = {#set cs_m68k_op->type#} p . fromIntegral . fromEnum - case m of + case v of Reg r -> do poke regP (fromIntegral $ fromEnum r :: CUInt) setType M68kOpReg @@ -159,10 +161,10 @@ instance Storable CsM68kOp where poke immP (fromIntegral i :: Int64) setType M68kOpImm DImm i -> do - poke dimmP (fromIntegral i :: Int64) + poke dimmP (realToFrac i :: CDouble) setType M68kOpFpDouble SImm i -> do - poke simmP (fromIntegral i :: Int64) + poke simmP (realToFrac i :: CFloat) setType M68kOpFpSingle RegPair (r0, r1) -> do poke reg0P (fromIntegral $ fromEnum r0 :: CUInt) @@ -192,12 +194,12 @@ instance Storable M68kOpSize where t <- fromIntegral <$> {#get m68k_op_size->type#} p case toEnum t of M68kSizeTypeCpu -> (CpuSize . toEnum . fromIntegral) <$> {#get m68k_op_size->cpu_size#} p - M68KSizeTypeFpu -> (FpuSize . toEnum . fromIntegral) <$> {#get m68k_op_size->fpu_size#} p - _ -> M68kOpSizeInvalid + M68kSizeTypeFpu -> (FpuSize . toEnum . fromIntegral) <$> {#get m68k_op_size->fpu_size#} p + _ -> return M68kOpSizeInvalid poke p opSize = do - let cpuP = plusPtr p {#offsetof m68_op_size->cpu_size#} - fpuP = plusPtr p {#offsetof m68_op_size->fpu_size#} - setType = {#set m68_op_size->type#} p . fromIntegral . fromEnum + let cpuP = plusPtr p {#offsetof m68k_op_size->cpu_size#} + fpuP = plusPtr p {#offsetof m68k_op_size->fpu_size#} + setType = {#set m68k_op_size->type#} p . fromIntegral . fromEnum case opSize of CpuSize c -> do poke cpuP (fromIntegral $ fromEnum c :: CUInt) @@ -205,7 +207,7 @@ instance Storable M68kOpSize where FpuSize f -> do poke fpuP (fromIntegral $ fromEnum f :: CUInt) setType M68kSizeTypeFpu - _ -> setType M68kSizeInvalid + _ -> setType M68kSizeTypeInvalid data CsM68k = CsM68k @@ -222,7 +224,7 @@ instance Storable CsM68k where peekArray num ptr <*> peek (plusPtr p {#offsetof cs_m68k->op_size#}) poke p (CsM68k o s) = do - poke (plusPtr p {#offsetof cs_m68k-op_size>#}) s + poke (plusPtr p {#offsetof cs_m68k->op_size#}) s {#set cs_m68k->op_count#} p (fromIntegral $ length o) if length o > 4 then error "operands overflew 4 elements" diff --git a/src/Hapstone/Internal/Tms320c64x.chs b/src/Hapstone/Internal/Tms320c64x.chs index c2bc518..aaa5993 100644 --- a/src/Hapstone/Internal/Tms320c64x.chs +++ b/src/Hapstone/Internal/Tms320c64x.chs @@ -42,31 +42,31 @@ import Hapstone.Internal.Util {#enum tms320c64x_mem_mod as Tms320c64xMemMod {underscoreToCase} deriving (Show, Eq, Bounded)#} -data Tms320c64xOpMem = Tms320c64xOpMem +data Tms320c64xOpMemStruct = Tms320c64xOpMemStruct { base :: Word32 , disp :: Word32 - , uint :: Word32 + , unit :: Word32 , scaled :: Word32 , disptype :: Word32 , direction :: Word32 , modify :: Word32 } deriving (Show, Eq) -instance Storable Tms320c64xOpMem where +instance Storable Tms320c64xOpMemStruct where sizeOf _ = {#sizeof tms320c64x_op_mem#} alignment _ = {#alignof tms320c64x_op_mem#} - peek p = Tms320c64xOpMem + peek p = Tms320c64xOpMemStruct <$> (fromIntegral <$> {#get tms320c64x_op_mem->base#} p) <*> (fromIntegral <$> {#get tms320c64x_op_mem->disp#} p) - <*> (fromIntegral <$> {#get tms320c64x_op_mem->uint#} p) + <*> (fromIntegral <$> {#get tms320c64x_op_mem->unit#} p) <*> (fromIntegral <$> {#get tms320c64x_op_mem->scaled#} p) <*> (fromIntegral <$> {#get tms320c64x_op_mem->disptype#} p) <*> (fromIntegral <$> {#get tms320c64x_op_mem->direction#} p) <*> (fromIntegral <$> {#get tms320c64x_op_mem->modify#} p) - poke p (Tms320c64xOpMem b d u s dt dr m) = do + poke p (Tms320c64xOpMemStruct b d u s dt dr m) = do {#set tms320c64x_op_mem->base#} p (fromIntegral b) {#set tms320c64x_op_mem->disp#} p (fromIntegral d) - {#set tms320c64x_op_mem->uint#} p (fromIntegral u) + {#set tms320c64x_op_mem->unit#} p (fromIntegral u) {#set tms320c64x_op_mem->scaled#} p (fromIntegral s) {#set tms320c64x_op_mem->disptype#} p (fromIntegral dt) {#set tms320c64x_op_mem->direction#} p (fromIntegral dr) @@ -76,7 +76,7 @@ data CsTms320c64xOpValue = Imm Int32 | Reg Word32 | RegPair Word32 - | Mem Tms320c64xOpMem + | Mem Tms320c64xOpMemStruct | CsTms320c64xOpInvalid deriving (Show, Eq) @@ -102,7 +102,7 @@ instance Storable CsTms320c64xOp where immP = plusPtr p {#offsetof cs_tms320c64x_op->imm#} memP = plusPtr p {#offsetof cs_tms320c64x_op->mem#} setType = {#set cs_tms320c64x_op->type#} p . fromIntegral . fromEnum - case op of + case v of Reg r -> do poke regP (fromIntegral r :: CUInt) setType Tms320c64xOpReg @@ -131,21 +131,21 @@ instance Storable CsTms320c64x where <$> do num <- fromIntegral <$> {#get cs_tms320c64x->op_count#} p let ptr = plusPtr p {#offsetof cs_tms320c64x->operands#} peekArray num ptr - <*> (,) - <$> fromIntegral <$> {#get cs_tms320c64x->condition.reg#} p - <*> fromIntegral <$> {#get cs_tms320c64x->condition.zero#} p - <*> (,,) - <$> fromIntegral <$> {#get cs_tms320c64x->funit.unit#} p - <*> fromIntegral <$> {#get cs_tms320c64x->funit.side#} p - <*> fromIntegral <$> {#get cs_tms320c64x->funit.crosspath#} p - <*> fromIntegral <$> {#get cs_tms320c64x->parallel#} p - poke p (CsTms320c64x o (r, z) (u, s, c) p) = do + <*> ((,) + <$> (fromIntegral <$> {#get cs_tms320c64x->condition.reg#} p) + <*> (fromIntegral <$> {#get cs_tms320c64x->condition.zero#} p)) + <*> ((,,) + <$> (fromIntegral <$> {#get cs_tms320c64x->funit.unit#} p) + <*> (fromIntegral <$> {#get cs_tms320c64x->funit.side#} p) + <*> (fromIntegral <$> {#get cs_tms320c64x->funit.crosspath#} p)) + <*> (fromIntegral <$> {#get cs_tms320c64x->parallel#} p) + poke p (CsTms320c64x o (r, z) (u, s, c) pr) = do {#set cs_tms320c64x->condition.reg#} p (fromIntegral r) {#set cs_tms320c64x->condition.zero#} p (fromIntegral z) {#set cs_tms320c64x->funit.unit#} p (fromIntegral u) {#set cs_tms320c64x->funit.side#} p (fromIntegral s) {#set cs_tms320c64x->funit.crosspath#} p (fromIntegral c) - {#set cs_tms320c64x->parallel#} p (fromIntegral p) + {#set cs_tms320c64x->parallel#} p (fromIntegral pr) {#set cs_tms320c64x->op_count#} p (fromIntegral $ length o) if length o > 8 then error "operands overflew 8 elements" @@ -157,7 +157,7 @@ instance Storable CsTms320c64x where {#enum tms320c64x_insn as Tms320c64xInsn {underscoreToCase} deriving (Show, Eq, Bounded)#} -{#enum tms320c64x_group_type as Tms320c64xGroupType {underscoreToCase} +{#enum tms320c64x_insn_group as Tms320c64xInsnGroup {underscoreToCase} deriving (Show, Eq, Bounded)#} {#enum tms320c64x_funit as Tms320c64xFunit {underscoreToCase} From 8406170d9d45360e2c3299090e5b46280dce2718 Mon Sep 17 00:00:00 2001 From: nganhkhoa Date: Sun, 21 Mar 2021 21:53:01 +0700 Subject: [PATCH 05/21] Fix offset of cs_detail --- src/Hapstone/Internal/Capstone.chs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Hapstone/Internal/Capstone.chs b/src/Hapstone/Internal/Capstone.chs index a5fd1c7..360b7fb 100644 --- a/src/Hapstone/Internal/Capstone.chs +++ b/src/Hapstone/Internal/Capstone.chs @@ -246,7 +246,7 @@ instance Storable CsDetail where peekDetail :: CsArch -> Ptr CsDetail -> IO CsDetail peekDetail arch p = do detail <- peek p - let bP = plusPtr p 48 + let bP = plusPtr p {#offsetof cs_detail->x86#} aI <- case arch of CsArchX86 -> X86 <$> peek bP CsArchArm64 -> Arm64 <$> peek bP From e129aa05d17504f36bb8438631eac90aeb0c3dcf Mon Sep 17 00:00:00 2001 From: nganhkhoa Date: Mon, 22 Mar 2021 23:29:23 +0700 Subject: [PATCH 06/21] Add arm binding test based on binding/python/test_arm.py --- examples/TestArm.hs | 134 ++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 134 insertions(+) create mode 100644 examples/TestArm.hs diff --git a/examples/TestArm.hs b/examples/TestArm.hs new file mode 100644 index 0000000..4214e48 --- /dev/null +++ b/examples/TestArm.hs @@ -0,0 +1,134 @@ +module Main where + +import Data.Word +import Text.Printf +import Numeric ( showHex ) + +import Hapstone.Capstone +import Hapstone.Internal.Capstone as Capstone + +arm_code = + [ 0x86 , 0x48 , 0x60 , 0xf4 , 0xED , 0xFF , 0xFF , 0xEB + , 0x04 , 0xe0 , 0x2d , 0xe5 , 0x00 , 0x00 , 0x00 , 0x00 + , 0xe0 , 0x83 , 0x22 , 0xe5 , 0xf1 , 0x02 , 0x03 , 0x0e + , 0x00 , 0x00 , 0xa0 , 0xe3 , 0x02 , 0x30 , 0xc1 , 0xe7 + , 0x00 , 0x00 , 0x53 , 0xe3 , 0x00 , 0x02 , 0x01 , 0xf1 + , 0x05 , 0x40 , 0xd0 , 0xe8 , 0xf4 , 0x80 , 0x00 , 0x00 + ] + +arm_code2 = + [ 0xd1 , 0xe8 , 0x00 , 0xf0 , 0xf0 , 0x24 , 0x04 , 0x07 + , 0x1f , 0x3c , 0xf2 , 0xc0 , 0x00 , 0x00 , 0x4f , 0xf0 + , 0x00 , 0x01 , 0x46 , 0x6c + ] + +thumb_code = + [ 0x70 , 0x47 , 0x00 , 0xf0 , 0x10 , 0xe8 , 0xeb , 0x46 + , 0x83 , 0xb0 , 0xc9 , 0x68 , 0x1f , 0xb1 , 0x30 , 0xbf + , 0xaf , 0xf3 , 0x20 , 0x84 , 0x52 , 0xf8 , 0x23 , 0xf0 + ] + +thumb_code2 = + [ 0x4f , 0xf0 , 0x00 , 0x01 , 0xbd , 0xe8 , 0x00 , 0x88 + , 0xd1 , 0xe8 , 0x00 , 0xf0 , 0x18 , 0xbf , 0xad , 0xbf + , 0xf3 , 0xff , 0x0b , 0x0c , 0x86 , 0xf3 , 0x00 , 0x89 + , 0x80 , 0xf3 , 0x00 , 0x8c , 0x4f , 0xfa , 0x99 , 0xf6 + , 0xd0 , 0xff , 0xa2 , 0x01 + ] + +thumb_mclass = [0xef, 0xf3, 0x02, 0x80] + +armv8 = + [ 0xe0, 0x3b, 0xb2, 0xee, 0x42, 0x00, 0x01, 0xe1, 0x51 + , 0xf0, 0x7f, 0xf5 + ] + +print_insn_detail :: Capstone.Csh -> Capstone.CsInsn -> IO () +print_insn_detail handle insn = putStrLn ("0x" ++ a ++ ":\t" ++ m ++ "\t" ++ o) + where + m = mnemonic insn + o = opStr insn + a = (showHex $ address insn) "" + +all_tests = + [ ( Disassembler { arch = Capstone.CsArchArm + , modes = [Capstone.CsModeArm] + , buffer = arm_code + , addr = 0x80001000 + , num = 0 + , Hapstone.Capstone.detail = True + , skip = Just (defaultSkipdataStruct) + , action = print_insn_detail + } + , "ARM" + ) + , ( Disassembler { arch = Capstone.CsArchArm + , modes = [Capstone.CsModeThumb] + , buffer = thumb_code + , addr = 0x80001000 + , num = 0 + , Hapstone.Capstone.detail = True + , skip = Just (defaultSkipdataStruct) + , action = print_insn_detail + } + , "Thumb" + ) + , ( Disassembler { arch = Capstone.CsArchArm + , modes = [Capstone.CsModeThumb] + , buffer = arm_code2 + , addr = 0x80001000 + , num = 0 + , Hapstone.Capstone.detail = True + , skip = Just (defaultSkipdataStruct) + , action = print_insn_detail + } + , "Thumb-mixed" + ) + , ( Disassembler { arch = Capstone.CsArchArm + , modes = [Capstone.CsModeThumb] + , buffer = thumb_code2 + , addr = 0x80001000 + , num = 0 + , Hapstone.Capstone.detail = True + , skip = Just (defaultSkipdataStruct) + , action = print_insn_detail + } + , "Thumb-2 & register named with numbers" + ) + , ( Disassembler { arch = Capstone.CsArchArm + , modes = [Capstone.CsModeThumb, Capstone.CsModeMclass] + , buffer = thumb_mclass + , addr = 0x80001000 + , num = 0 + , Hapstone.Capstone.detail = True + , skip = Just (defaultSkipdataStruct) + , action = print_insn_detail + } + , "Thumb-MClass" + ) + , ( Disassembler { arch = Capstone.CsArchArm + , modes = [Capstone.CsModeArm, Capstone.CsModeV8] + , buffer = armv8 + , addr = 0x80001000 + , num = 0 + , Hapstone.Capstone.detail = True + , skip = Just (defaultSkipdataStruct) + , action = print_insn_detail + } + , "Arm-V8" + ) + ] + +main :: IO () +main = do + mapM test_disasm all_tests + pure () + where + test_disasm (dis, platform) = do + putStrLn $ replicate 16 '*' + putStrLn $ "Platform: " ++ platform + putStrLn $ "Code: " ++ to_hex (buffer dis) + putStrLn "Disasm:" + disasmIO $ dis + + to_hex code = unwords (map (printf "0x%02X") code) From 5a7597dc3f49e2193e88cd56a503d6d558e81dcc Mon Sep 17 00:00:00 2001 From: nganhkhoa Date: Mon, 22 Mar 2021 23:30:45 +0700 Subject: [PATCH 07/21] Add arm64 binding test based on binding/python/test_arm64.py --- examples/TestArm64.hs | 54 +++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 54 insertions(+) create mode 100644 examples/TestArm64.hs diff --git a/examples/TestArm64.hs b/examples/TestArm64.hs new file mode 100644 index 0000000..bebd1fb --- /dev/null +++ b/examples/TestArm64.hs @@ -0,0 +1,54 @@ +module Main where + +import Data.Word +import Text.Printf +import Numeric ( showHex ) + +import Hapstone.Capstone +import Hapstone.Internal.Capstone as Capstone + +arm_code = + [ 0x09, 0x00, 0x38, 0xd5, 0xbf, 0x40, 0x00, 0xd5, 0x0c + , 0x05, 0x13, 0xd5, 0x20, 0x50, 0x02, 0x0e, 0x20, 0xe4 + , 0x3d, 0x0f, 0x00, 0x18, 0xa0, 0x5f, 0xa2, 0x00, 0xae + , 0x9e, 0x9f, 0x37, 0x03, 0xd5, 0xbf, 0x33, 0x03, 0xd5 + , 0xdf, 0x3f, 0x03, 0xd5, 0x21, 0x7c, 0x02, 0x9b, 0x21 + , 0x7c, 0x00, 0x53, 0x00, 0x40, 0x21, 0x4b, 0xe1, 0x0b + , 0x40, 0xb9, 0x20, 0x04, 0x81, 0xda, 0x20, 0x08, 0x02 + , 0x8b, 0x10, 0x5b, 0xe8, 0x3c + ] + +print_insn_detail :: Capstone.Csh -> Capstone.CsInsn -> IO () +print_insn_detail handle insn = putStrLn ("0x" ++ a ++ ":\t" ++ m ++ "\t" ++ o) + where + m = mnemonic insn + o = opStr insn + a = (showHex $ address insn) "" + +all_tests = + [ ( Disassembler { arch = Capstone.CsArchArm64 + , modes = [Capstone.CsModeArm] + , buffer = arm_code + , addr = 0x80001000 + , num = 0 + , Hapstone.Capstone.detail = True + , skip = Just (defaultSkipdataStruct) + , action = print_insn_detail + } + , "ARM-64" + ) + ] + +main :: IO () +main = do + mapM test_disasm all_tests + pure () + where + test_disasm (dis, platform) = do + putStrLn $ replicate 16 '*' + putStrLn $ "Platform: " ++ platform + putStrLn $ "Code: " ++ to_hex (buffer dis) + putStrLn "Disasm:" + disasmIO $ dis + + to_hex code = unwords (map (printf "0x%02X") code) From 31405e7f6b698b78e1d47edc51ece52e59a96ae4 Mon Sep 17 00:00:00 2001 From: nganhkhoa Date: Mon, 22 Mar 2021 23:31:38 +0700 Subject: [PATCH 08/21] Add evm binding test based on binding/python/test_evm.py --- examples/TestEvm.hs | 49 +++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 49 insertions(+) create mode 100644 examples/TestEvm.hs diff --git a/examples/TestEvm.hs b/examples/TestEvm.hs new file mode 100644 index 0000000..8411f68 --- /dev/null +++ b/examples/TestEvm.hs @@ -0,0 +1,49 @@ +module Main where + +import Data.Word +import Text.Printf +import Numeric ( showHex ) + +import Hapstone.Capstone +import Hapstone.Internal.Capstone as Capstone + +evm_code = + [ 0x60 + , 0x61 + , 0x55 + ] + +print_insn_detail :: Capstone.Csh -> Capstone.CsInsn -> IO () +print_insn_detail handle insn = putStrLn ("0x" ++ a ++ ":\t" ++ m ++ "\t" ++ o) + where + m = mnemonic insn + o = opStr insn + a = (showHex $ address insn) "" + +all_tests = + [ ( Disassembler { arch = Capstone.CsArchEvm + , modes = [] + , buffer = evm_code + , addr = 0x100 + , num = 0 + , Hapstone.Capstone.detail = True + , skip = Just (defaultSkipdataStruct) + , action = print_insn_detail + } + , "EVM" + ) + ] + +main :: IO () +main = do + mapM test_disasm all_tests + pure () + where + test_disasm (dis, platform) = do + putStrLn $ replicate 16 '*' + putStrLn $ "Platform: " ++ platform + putStrLn $ "Code: " ++ to_hex (buffer dis) + putStrLn "Disasm:" + disasmIO $ dis + + to_hex code = unwords (map (printf "0x%02X") code) From 5d3c9474959e38ee19b28ba037e2c09fe5e61272 Mon Sep 17 00:00:00 2001 From: nganhkhoa Date: Mon, 22 Mar 2021 23:35:58 +0700 Subject: [PATCH 09/21] Add mk680x binding test based on binding/python/test_mk680x.py --- examples/TestM680x.hs | 231 ++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 231 insertions(+) create mode 100644 examples/TestM680x.hs diff --git a/examples/TestM680x.hs b/examples/TestM680x.hs new file mode 100644 index 0000000..d787108 --- /dev/null +++ b/examples/TestM680x.hs @@ -0,0 +1,231 @@ +module Main where + +import Data.Word +import Text.Printf +import Numeric ( showHex ) + +import Hapstone.Capstone +import Hapstone.Internal.Capstone as Capstone + + +m6800_code = + [ 0x01, 0x09, 0x36, 0x64, 0x7f, 0x74, 0x10, 0x00, 0x90 + , 0x10, 0xA4, 0x10, 0xb6, 0x10, 0x00, 0x39 + ] + +m6801_code = + [ 0x04, 0x05, 0x3c, 0x3d, 0x38, 0x93, 0x10, 0xec, 0x10 + , 0xed, 0x10, 0x39 + ] + +m6805_code = + [ 0x04, 0x7f, 0x00, 0x17, 0x22, 0x28, 0x00, 0x2e, 0x00 + , 0x40, 0x42, 0x5a, 0x70, 0x8e, 0x97, 0x9c, 0xa0, 0x15 + , 0xad, 0x00, 0xc3, 0x10, 0x00, 0xda, 0x12, 0x34, 0xe5 + , 0x7f, 0xfe + ] + +m6808_code = + [ 0x31, 0x22, 0x00, 0x35, 0x22, 0x45, 0x10, 0x00, 0x4b + , 0x00, 0x51, 0x10, 0x52, 0x5e, 0x22, 0x62, 0x65, 0x12 + , 0x34, 0x72, 0x84, 0x85, 0x86, 0x87, 0x8a, 0x8b, 0x8c + , 0x94, 0x95, 0xa7, 0x10, 0xaf, 0x10, 0x9e, 0x60, 0x7f + , 0x9e, 0x6b, 0x7f, 0x00, 0x9e, 0xd6, 0x10, 0x00, 0x9e + , 0xe6, 0x7f + ] + +hcs08_code = + [ 0x32, 0x10, 0x00, 0x9e, 0xae, 0x9e, 0xce, 0x7f, 0x9e + , 0xbe, 0x10, 0x00, 0x9e, 0xfe, 0x7f, 0x3e, 0x10, 0x00 + , 0x9e, 0xf3, 0x7f, 0x96, 0x10, 0x00, 0x9e, 0xff, 0x7f + , 0x82 + ] + +hd6301_code = + [ 0x6b, 0x10, 0x00, 0x71, 0x10, 0x00, 0x72, 0x10, 0x10 + , 0x39 + ] + +m6809_code = + [ 0x06, 0x10, 0x19, 0x1a, 0x55, 0x1e, 0x01, 0x23, 0xe9 + , 0x31, 0x06, 0x34, 0x55, 0xa6, 0x81, 0xa7, 0x89, 0x7f + , 0xff, 0xa6, 0x9d, 0x10, 0x00, 0xa7, 0x91, 0xa6, 0x9f + , 0x10, 0x00, 0x11, 0xac, 0x99, 0x10, 0x00, 0x39, 0xA6 + , 0x07, 0xA6, 0x27, 0xA6, 0x47, 0xA6, 0x67, 0xA6, 0x0F + , 0xA6, 0x10, 0xA6, 0x80, 0xA6, 0x81, 0xA6, 0x82, 0xA6 + , 0x83, 0xA6, 0x84, 0xA6, 0x85, 0xA6, 0x86, 0xA6, 0x88 + , 0x7F, 0xA6, 0x88, 0x80, 0xA6, 0x89, 0x7F, 0xFF, 0xA6 + , 0x89, 0x80, 0x00, 0xA6, 0x8B, 0xA6, 0x8C, 0x10, 0xA6 + , 0x8D, 0x10, 0x00, 0xA6, 0x91, 0xA6, 0x93, 0xA6, 0x94 + , 0xA6, 0x95, 0xA6, 0x96, 0xA6, 0x98, 0x7F, 0xA6, 0x98 + , 0x80, 0xA6, 0x99, 0x7F, 0xFF, 0xA6, 0x99, 0x80, 0x00 + , 0xA6, 0x9B, 0xA6, 0x9C, 0x10, 0xA6, 0x9D, 0x10, 0x00 + , 0xA6, 0x9F, 0x10, 0x00 + ] + +m6811_code = + [ 0x02, 0x03, 0x12, 0x7f, 0x10, 0x00, 0x13, 0x99, 0x08 + , 0x00, 0x14, 0x7f, 0x02, 0x15, 0x7f, 0x01, 0x1e, 0x7f + , 0x20, 0x00, 0x8f, 0xcf, 0x18, 0x08, 0x18, 0x30, 0x18 + , 0x3c, 0x18, 0x67, 0x18, 0x8c, 0x10, 0x00, 0x18, 0x8f + , 0x18, 0xce, 0x10, 0x00, 0x18, 0xff, 0x10, 0x00, 0x1a + , 0xa3, 0x7f, 0x1a, 0xac, 0x1a, 0xee, 0x7f, 0x1a, 0xef + , 0x7f, 0xcd, 0xac, 0x7f + ] + +cpu12_code = + [ 0x00, 0x04, 0x01, 0x00, 0x0c, 0x00, 0x80, 0x0e, 0x00 + , 0x80, 0x00, 0x11, 0x1e, 0x10, 0x00, 0x80, 0x00, 0x3b + , 0x4a, 0x10, 0x00, 0x04, 0x4b, 0x01, 0x04, 0x4f, 0x7f + , 0x80, 0x00, 0x8f, 0x10, 0x00, 0xb7, 0x52, 0xb7, 0xb1 + , 0xa6, 0x67, 0xa6, 0xfe, 0xa6, 0xf7, 0x18, 0x02, 0xe2 + , 0x30, 0x39, 0xe2, 0x10, 0x00, 0x18, 0x0c, 0x30, 0x39 + , 0x10, 0x00, 0x18, 0x11, 0x18, 0x12, 0x10, 0x00, 0x18 + , 0x19, 0x00, 0x18, 0x1e, 0x00, 0x18, 0x3e, 0x18, 0x3f + , 0x00 + ] + +hd6309_code = + [ 0x01, 0x10, 0x10, 0x62, 0x10, 0x10, 0x7b, 0x10, 0x10 + , 0x00, 0xcd, 0x49, 0x96, 0x02, 0xd2, 0x10, 0x30, 0x23 + , 0x10, 0x38, 0x10, 0x3b, 0x10, 0x53, 0x10, 0x5d, 0x11 + , 0x30, 0x43, 0x10, 0x11, 0x37, 0x25, 0x10, 0x11, 0x38 + , 0x12, 0x11, 0x39, 0x23, 0x11, 0x3b, 0x34, 0x11, 0x8e + , 0x10, 0x00, 0x11, 0xaf, 0x10, 0x11, 0xab, 0x10, 0x11 + , 0xf6, 0x80, 0x00 + ] + + +print_insn_detail :: Capstone.Csh -> Capstone.CsInsn -> IO () +print_insn_detail handle insn = putStrLn ("0x" ++ a ++ ":\t" ++ m ++ "\t" ++ o) + where + m = mnemonic insn + o = opStr insn + a = (showHex $ address insn) "" + +all_tests = + [ ( Disassembler { arch = Capstone.CsArchM680x + , modes = [CsModeM680x6301] + , buffer = hd6301_code + , addr = 0x1000 + , num = 0 + , Hapstone.Capstone.detail = True + , skip = Just (defaultSkipdataStruct) + , action = print_insn_detail + } + , "M680X_HD6301" + ) + , ( Disassembler { arch = Capstone.CsArchM680x + , modes = [CsModeM680x6309] + , buffer = hd6309_code + , addr = 0x1000 + , num = 0 + , Hapstone.Capstone.detail = True + , skip = Just (defaultSkipdataStruct) + , action = print_insn_detail + } + , "M680X_HD6309" + ) + , ( Disassembler { arch = Capstone.CsArchM680x + , modes = [CsModeM680x6800] + , buffer = m6800_code + , addr = 0x1000 + , num = 0 + , Hapstone.Capstone.detail = True + , skip = Just (defaultSkipdataStruct) + , action = print_insn_detail + } + , "M680X_M6800" + ) + , ( Disassembler { arch = Capstone.CsArchM680x + , modes = [CsModeM680x6801] + , buffer = m6801_code + , addr = 0x1000 + , num = 0 + , Hapstone.Capstone.detail = True + , skip = Just (defaultSkipdataStruct) + , action = print_insn_detail + } + , "M680X_MX6801" + ) + , ( Disassembler { arch = Capstone.CsArchM680x + , modes = [CsModeM680x6805] + , buffer = m6805_code + , addr = 0x1000 + , num = 0 + , Hapstone.Capstone.detail = True + , skip = Just (defaultSkipdataStruct) + , action = print_insn_detail + } + , "M680X_M68HC05" + ) + , ( Disassembler { arch = Capstone.CsArchM680x + , modes = [CsModeM680x6808] + , buffer = m6808_code + , addr = 0x1000 + , num = 0 + , Hapstone.Capstone.detail = True + , skip = Just (defaultSkipdataStruct) + , action = print_insn_detail + } + , "M680X_M68HC08" + ) + , ( Disassembler { arch = Capstone.CsArchM680x + , modes = [CsModeM680x6809] + , buffer = m6809_code + , addr = 0x1000 + , num = 0 + , Hapstone.Capstone.detail = True + , skip = Just (defaultSkipdataStruct) + , action = print_insn_detail + } + , "M680X_M6809" + ) + , ( Disassembler { arch = Capstone.CsArchM680x + , modes = [CsModeM680x6811] + , buffer = m6811_code + , addr = 0x1000 + , num = 0 + , Hapstone.Capstone.detail = True + , skip = Just (defaultSkipdataStruct) + , action = print_insn_detail + } + , "M680X_M68HC11" + ) + , ( Disassembler { arch = Capstone.CsArchM680x + , modes = [CsModeM680xCpu12] + , buffer = cpu12_code + , addr = 0x1000 + , num = 0 + , Hapstone.Capstone.detail = True + , skip = Just (defaultSkipdataStruct) + , action = print_insn_detail + } + , "M680X_CPU12" + ) + , ( Disassembler { arch = Capstone.CsArchM680x + , modes = [CsModeM680xHcs08] + , buffer = hcs08_code + , addr = 0x1000 + , num = 0 + , Hapstone.Capstone.detail = True + , skip = Just (defaultSkipdataStruct) + , action = print_insn_detail + } + , "M680X_HCS08" + ) + ] + +main :: IO () +main = do + mapM test_disasm all_tests + pure () + where + test_disasm (dis, platform) = do + putStrLn $ replicate 16 '*' + putStrLn $ "Platform: " ++ platform + putStrLn $ "Code: " ++ to_hex (buffer dis) + putStrLn "Disasm:" + disasmIO $ dis + + to_hex code = unwords (map (printf "0x%02X") code) From 575e90c30c15a8c2e59a68deceecfe1e9b0bcf21 Mon Sep 17 00:00:00 2001 From: nganhkhoa Date: Tue, 23 Mar 2021 00:24:23 +0700 Subject: [PATCH 10/21] Add mk68k binding test based on binding/python/test_mk68k.py --- examples/TestM68k.hs | 54 ++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 54 insertions(+) create mode 100644 examples/TestM68k.hs diff --git a/examples/TestM68k.hs b/examples/TestM68k.hs new file mode 100644 index 0000000..c4bed1b --- /dev/null +++ b/examples/TestM68k.hs @@ -0,0 +1,54 @@ +module Main where + +import Data.Word +import Text.Printf +import Numeric ( showHex ) + +import Hapstone.Capstone +import Hapstone.Internal.Capstone as Capstone + +m68k_code = + [ 0x4c, 0x00, 0x54, 0x04, 0x48, 0xe7, 0xe0, 0x30, 0x4c + , 0xdf, 0x0c, 0x07, 0xd4, 0x40, 0x87, 0x5a, 0x4e, 0x71 + , 0x02, 0xb4, 0xc0, 0xde, 0xc0, 0xde, 0x5c, 0x00, 0x1d + , 0x80, 0x71, 0x12, 0x01, 0x23, 0xf2, 0x3c, 0x44, 0x22 + , 0x40, 0x49, 0x0e, 0x56, 0x54, 0xc5, 0xf2, 0x3c, 0x44 + , 0x00, 0x44, 0x7a, 0x00, 0x00, 0xf2, 0x00, 0x0a, 0x28 + , 0x4e, 0xb9, 0x00, 0x00, 0x00, 0x12, 0x4e, 0x75 + ] + + +print_insn_detail :: Capstone.Csh -> Capstone.CsInsn -> IO () +print_insn_detail handle insn = putStrLn ("0x" ++ a ++ ":\t" ++ m ++ "\t" ++ o) + where + m = mnemonic insn + o = opStr insn + a = (showHex $ address insn) "" + +all_tests = + [ ( Disassembler { arch = Capstone.CsArchM68k + , modes = [CsModeBigEndian, CsModeM68k040] + , buffer = m68k_code + , addr = 0x1000 + , num = 0 + , Hapstone.Capstone.detail = True + , skip = Just (defaultSkipdataStruct) + , action = print_insn_detail + } + , "M68K" + ) + ] + +main :: IO () +main = do + mapM test_disasm all_tests + pure () + where + test_disasm (dis, platform) = do + putStrLn $ replicate 16 '*' + putStrLn $ "Platform: " ++ platform + putStrLn $ "Code: " ++ to_hex (buffer dis) + putStrLn "Disasm:" + disasmIO $ dis + + to_hex code = unwords (map (printf "0x%02X") code) From 2e4c5fd9f364ab0e4833e45e73d6703ef93f403d Mon Sep 17 00:00:00 2001 From: nganhkhoa Date: Tue, 23 Mar 2021 00:24:51 +0700 Subject: [PATCH 11/21] Fix size and offset of cs_mips_op --- src/Hapstone/Internal/Mips.chs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/Hapstone/Internal/Mips.chs b/src/Hapstone/Internal/Mips.chs index 56847f8..c8a07de 100644 --- a/src/Hapstone/Internal/Mips.chs +++ b/src/Hapstone/Internal/Mips.chs @@ -61,8 +61,8 @@ data CsMipsOp deriving (Show, Eq) instance Storable CsMipsOp where - sizeOf _ = {#sizeof mips_op_mem#} - alignment _ = {#alignof mips_op_mem#} + sizeOf _ = {#sizeof cs_mips_op#} + alignment _ = {#alignof cs_mips_op#} peek p = do t <- fromIntegral <$> {#get cs_mips_op->type#} p let memP = plusPtr p {#offsetof cs_mips_op->mem#} From 9bd0a6bb4f10730f97130245fa97c93f3d260bb7 Mon Sep 17 00:00:00 2001 From: nganhkhoa Date: Tue, 23 Mar 2021 00:25:15 +0700 Subject: [PATCH 12/21] Add mips binding test based on binding/python/test_mips.py --- examples/TestMips.hs | 95 ++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 95 insertions(+) create mode 100644 examples/TestMips.hs diff --git a/examples/TestMips.hs b/examples/TestMips.hs new file mode 100644 index 0000000..7c2ea81 --- /dev/null +++ b/examples/TestMips.hs @@ -0,0 +1,95 @@ +module Main where + +import Data.Word +import Text.Printf +import Numeric ( showHex ) + +import Hapstone.Capstone +import Hapstone.Internal.Capstone as Capstone + +mips_code = + [ 0x0C, 0x10, 0x00, 0x97, 0x00, 0x00, 0x00, 0x00, 0x24 + , 0x02, 0x00, 0x0c, 0x8f, 0xa2, 0x00, 0x00, 0x34, 0x21 + , 0x34, 0x56 + ] + +mips_code2 = + [ 0x56, 0x34, 0x21, 0x34, 0xc2, 0x17, 0x01, 0x00 + ] + +mips_32r6m = + [ 0x00, 0x07, 0x00, 0x07, 0x00, 0x11, 0x93, 0x7c, 0x01 + , 0x8c, 0x8b, 0x7c, 0x00, 0xc7, 0x48, 0xd0 + ] + +mips_32r6 = + [ 0xec, 0x80, 0x00, 0x19, 0x7c, 0x43, 0x22, 0xa0 + ] + +print_insn_detail :: Capstone.Csh -> Capstone.CsInsn -> IO () +print_insn_detail handle insn = putStrLn ("0x" ++ a ++ ":\t" ++ m ++ "\t" ++ o) + where + m = mnemonic insn + o = opStr insn + a = (showHex $ address insn) "" + +all_tests = + [ ( Disassembler { arch = Capstone.CsArchMips + , modes = [CsModeBigEndian, CsModeMips32] + , buffer = mips_code + , addr = 0x1000 + , num = 0 + , Hapstone.Capstone.detail = True + , skip = Just (defaultSkipdataStruct) + , action = print_insn_detail + } + , "MIPS-32 (Big-endian)" + ) + , ( Disassembler { arch = Capstone.CsArchMips + , modes = [CsModeLittleEndian, CsModeMips64] + , buffer = mips_code2 + , addr = 0x1000 + , num = 0 + , Hapstone.Capstone.detail = True + , skip = Just (defaultSkipdataStruct) + , action = print_insn_detail + } + , "MIPS-64-EL (Little-endian)" + ) + , ( Disassembler { arch = Capstone.CsArchMips + , modes = [CsModeBigEndian, CsModeMicro, CsModeMips32r6] + , buffer = mips_32r6m + , addr = 0x1000 + , num = 0 + , Hapstone.Capstone.detail = True + , skip = Just (defaultSkipdataStruct) + , action = print_insn_detail + } + , "MIPS-32R6 | Micro (Big-endian)" + ) + , ( Disassembler { arch = Capstone.CsArchMips + , modes = [CsModeBigEndian, CsModeMips32r6] + , buffer = mips_32r6 + , addr = 0x1000 + , num = 0 + , Hapstone.Capstone.detail = True + , skip = Just (defaultSkipdataStruct) + , action = print_insn_detail + } + , "MIPS-32R6 (Big-endian)" + ) + ] + +main :: IO () +main = do + mapM test_disasm all_tests + pure () + where + test_disasm (dis, platform) = do + putStrLn $ replicate 16 '*' + putStrLn $ "Platform: " ++ platform + putStrLn $ "Code: " ++ to_hex (buffer dis) + putStrLn "Disasm:" + disasmIO $ dis + + to_hex code = unwords (map (printf "0x%02X") code) From a30abe829046ed64de1f4d9b841d9bdf1e3373bc Mon Sep 17 00:00:00 2001 From: nganhkhoa Date: Wed, 24 Mar 2021 23:45:21 +0700 Subject: [PATCH 13/21] Detailed TestArm and Bool value decoding of CsArm and CsArmOp update --- examples/TestArm.hs | 137 +++++++++++++++++++++++++++++++++- src/Hapstone/Internal/Arm.chs | 6 +- 2 files changed, 139 insertions(+), 4 deletions(-) diff --git a/examples/TestArm.hs b/examples/TestArm.hs index 4214e48..ddad428 100644 --- a/examples/TestArm.hs +++ b/examples/TestArm.hs @@ -6,6 +6,7 @@ import Numeric ( showHex ) import Hapstone.Capstone import Hapstone.Internal.Capstone as Capstone +import Hapstone.Internal.Arm as Arm arm_code = [ 0x86 , 0x48 , 0x60 , 0xf4 , 0xED , 0xFF , 0xFF , 0xEB @@ -44,12 +45,145 @@ armv8 = ] print_insn_detail :: Capstone.Csh -> Capstone.CsInsn -> IO () -print_insn_detail handle insn = putStrLn ("0x" ++ a ++ ":\t" ++ m ++ "\t" ++ o) +print_insn_detail handle insn = do + putStrLn ("0x" ++ a ++ ":\t" ++ m ++ "\t" ++ o) + case Capstone.detail insn of + Just detail -> do + case archInfo detail of + Just (Arm arch) -> do + printArchInsnInfo arch + _ -> pure() + _ -> pure () + putStrLn "" where m = mnemonic insn o = opStr insn a = (showHex $ address insn) "" + printArchInsnInfo arch = do + if length operands > 0 + then putStrLn ("\topcount: " ++ ((show . length) operands)) + else pure () + mapM_ printOperandDetail $ zip [0..] operands + if updateFlags arch + then putStrLn "\tUpdate-flags: True" + else pure () + if writeback arch + then putStrLn "\tWrite-back: True" + else pure () + case cc arch of + ArmCcAl -> pure () + ArmCcInvalid -> pure () + _ -> putStrLn (printf "\tCode condition: %s" (show $ cc arch)) + case cpsMode arch of + ArmCpsmodeInvalid -> pure () + _ -> + putStrLn (printf "\tCPSI-mode: %s" (show $ cpsMode arch)) + case cpsFlag arch of + ArmCpsflagInvalid -> pure () + _ -> + putStrLn (printf "\tCPSI-flag: %s" (show $ cpsFlag arch)) + case vectorData arch of + ArmVectordataInvalid -> pure () + _ -> putStrLn (printf "\tVector-data: %s" (show $ vectorData arch)) + if vectorSize arch /= 0 + then putStrLn (printf "\tVector-size: %u" (vectorSize arch)) + else pure () + if usermode arch + then putStrLn (printf "\tUser-mode: True") + else pure () + case memBarrier arch of + ArmMbInvalid -> pure () + _ -> putStrLn (printf "\tMem-barrier: %s" (show $ memBarrier arch)) + + -- TODO: read/writer register, wait cs_reg_access + where + operands = Arm.operands arch + + printOperandDetail :: (Int, Arm.CsArmOp) -> IO () + printOperandDetail (i, op) = do + case value op of + Reg reg -> + let Just reg_name = Capstone.csRegName handle reg in + putStrLn (printf "\t\toperands[%u].type: REG = %s" i reg_name) + Sysreg reg -> + putStrLn (printf "\t\toperands[%u].type: SYSREG = %u" i reg) + Imm imm -> + putStrLn (printf "\t\toperands[%u].type: IMM = 0x%x" i imm) + CImm imm -> + putStrLn (printf "\t\toperands[%u].type: C-IMM = %u" i imm) + PImm imm -> + putStrLn (printf "\t\toperands[%u].type: P-IMM = %u" i imm) + Fp fp -> + putStrLn (printf "\t\toperands[%u].type: FP = %f" i fp) + Setend setend -> + case setend of + ArmSetendBe -> + putStrLn (printf "\t\toperands[%u].type: SETEND = be" i) + ArmSetendLe -> + putStrLn (printf "\t\toperands[%u].type: SETEND = le" i) + Mem mem -> do + let base_ = base mem + index_ = index mem + scale_ = scale mem + disp_ = disp mem + lshift_ = lshift mem + putStrLn (printf "\t\toperands[%u].type: MEM" i) + if base_ /= ArmRegInvalid + then do + let Just reg_name = Capstone.csRegName handle base_ in + putStrLn (printf "\t\t\toperands[%u].mem.base: REG = %s" i reg_name) + else pure () + if index_ /= ArmRegInvalid + then do + let Just reg_name = Capstone.csRegName handle index_ in + putStrLn (printf "\t\t\toperands[%u].mem.index: REG = %s" i reg_name) + else pure () + if scale_ /= 1 + then putStrLn (printf "\t\t\toperands[%u].mem.scale: %u" i scale_) + else pure () + if disp_ /= 0 + then putStrLn (printf "\t\t\toperands[%u].mem.disp: 0x%x" i disp_) + else pure () + case lshift_ of + Just ls -> putStrLn (printf "\t\t\toperands[%u].mem.lshift: 0x%x" i ls) + Nothing -> pure () + _ -> + putStrLn (printf "\t\toperands[%u].type: UNKNOWN" i) + + let neon_lane_ = neon_lane op + access_ = access op + shift_ = shift op + subtracted_ = subtracted op + vector_index_ = vectorIndex op + + if neon_lane_ /= -1 + then putStrLn (printf "\t\toperands[%u].neon_lane = %u" neon_lane_) + else pure () + + -- case access_ of + -- csAcRead -> + -- putStrLn (printf "\t\toperands[%u].access: READ" i) + -- putStrLn "" + -- csAcWrite -> + -- putStrLn (printf "\t\toperands[%u].access: WRITE" i) + -- putStrLn "" + -- csAcReadWrite -> + -- putStrLn (printf "\t\toperands[%u].access: READ | WRITE" i) + -- putStrLn "" + + if (fst shift_ /= ArmSftInvalid) && (snd shift_ /= 0) + then putStrLn (printf "\t\t\tShift: %s = %u" (show $ fst shift_) (snd shift_)) + else pure () + if vector_index_ /= -1 + then putStrLn (printf "\t\t\toperands[%u].vector_index = %u" i vector_index_) + else pure () + + if subtracted_ + then putStrLn (printf "\t\t\toperands[%u].subtracted = True" i) + else pure () + + all_tests = [ ( Disassembler { arch = Capstone.CsArchArm , modes = [Capstone.CsModeArm] @@ -130,5 +264,6 @@ main = do putStrLn $ "Code: " ++ to_hex (buffer dis) putStrLn "Disasm:" disasmIO $ dis + -- ioError (userError "Stop") to_hex code = unwords (map (printf "0x%02X") code) diff --git a/src/Hapstone/Internal/Arm.chs b/src/Hapstone/Internal/Arm.chs index b8588ae..3a9ec94 100644 --- a/src/Hapstone/Internal/Arm.chs +++ b/src/Hapstone/Internal/Arm.chs @@ -135,7 +135,7 @@ instance Storable CsArmOp where ArmOpMem -> Mem <$> (peek memP) ArmOpSetend -> (Setend . toEnum . fromIntegral) <$> {#get cs_arm_op->setend#} p _ -> return Undefined - <*> ({#get cs_arm_op->subtracted#} p) + <*> (toBool <$> (peekByteOff p {#offsetof cs_arm_op->subtracted#} :: IO Word8)) <*> (fromIntegral <$> {#get cs_arm_op->access#} p) <*> (fromIntegral <$> {#get cs_arm_op->neon_lane#} p) poke p (CsArmOp vI (sh, shV) val sub acc neon) = do @@ -208,8 +208,8 @@ instance Storable CsArm where <*> ((toEnum . fromIntegral) <$> {#get cs_arm->cps_mode#} p) <*> ((toEnum . fromIntegral) <$> {#get cs_arm->cps_flag#} p) <*> ((toEnum . fromIntegral) <$> {#get cs_arm->cc#} p) - <*> ({#get cs_arm->update_flags#} p) - <*> ({#get cs_arm->writeback#} p) + <*> (toBool <$> (peekByteOff p {#offsetof cs_arm->update_flags#} :: IO Word8)) + <*> (toBool <$> (peekByteOff p {#offsetof cs_arm->writeback#} :: IO Word8)) <*> ((toEnum . fromIntegral) <$> {#get cs_arm->mem_barrier#} p) <*> do num <- fromIntegral <$> {#get cs_arm->op_count#} p let ptr = plusPtr p {#offsetof cs_arm->operands#} From 1584780fe20de92de71c324e8bbf51d40e6dd266 Mon Sep 17 00:00:00 2001 From: nganhkhoa Date: Thu, 25 Mar 2021 00:01:05 +0700 Subject: [PATCH 14/21] Change from if-then-else to when --- examples/TestArm.hs | 78 +++++++++++++++++++-------------------------- 1 file changed, 33 insertions(+), 45 deletions(-) diff --git a/examples/TestArm.hs b/examples/TestArm.hs index ddad428..b492fd5 100644 --- a/examples/TestArm.hs +++ b/examples/TestArm.hs @@ -1,5 +1,6 @@ module Main where +import Control.Monad import Data.Word import Text.Printf import Numeric ( showHex ) @@ -61,16 +62,13 @@ print_insn_detail handle insn = do a = (showHex $ address insn) "" printArchInsnInfo arch = do - if length operands > 0 - then putStrLn ("\topcount: " ++ ((show . length) operands)) - else pure () + when (length operands > 0) + $ putStrLn ("\topcount: " ++ ((show . length) operands)) mapM_ printOperandDetail $ zip [0..] operands - if updateFlags arch - then putStrLn "\tUpdate-flags: True" - else pure () - if writeback arch - then putStrLn "\tWrite-back: True" - else pure () + when (updateFlags arch) + $ putStrLn "\tUpdate-flags: True" + when (writeback arch) + $ putStrLn "\tWrite-back: True" case cc arch of ArmCcAl -> pure () ArmCcInvalid -> pure () @@ -86,12 +84,10 @@ print_insn_detail handle insn = do case vectorData arch of ArmVectordataInvalid -> pure () _ -> putStrLn (printf "\tVector-data: %s" (show $ vectorData arch)) - if vectorSize arch /= 0 - then putStrLn (printf "\tVector-size: %u" (vectorSize arch)) - else pure () - if usermode arch - then putStrLn (printf "\tUser-mode: True") - else pure () + when (vectorSize arch /= 0) + $ putStrLn (printf "\tVector-size: %u" (vectorSize arch)) + when (usermode arch) + $ putStrLn (printf "\tUser-mode: True") case memBarrier arch of ArmMbInvalid -> pure () _ -> putStrLn (printf "\tMem-barrier: %s" (show $ memBarrier arch)) @@ -129,22 +125,19 @@ print_insn_detail handle insn = do disp_ = disp mem lshift_ = lshift mem putStrLn (printf "\t\toperands[%u].type: MEM" i) - if base_ /= ArmRegInvalid - then do - let Just reg_name = Capstone.csRegName handle base_ in - putStrLn (printf "\t\t\toperands[%u].mem.base: REG = %s" i reg_name) - else pure () - if index_ /= ArmRegInvalid - then do - let Just reg_name = Capstone.csRegName handle index_ in - putStrLn (printf "\t\t\toperands[%u].mem.index: REG = %s" i reg_name) - else pure () - if scale_ /= 1 - then putStrLn (printf "\t\t\toperands[%u].mem.scale: %u" i scale_) - else pure () - if disp_ /= 0 - then putStrLn (printf "\t\t\toperands[%u].mem.disp: 0x%x" i disp_) - else pure () + when (base_ /= ArmRegInvalid) + $ do + let Just reg_name = Capstone.csRegName handle base_ + putStrLn (printf "\t\t\toperands[%u].mem.base: REG = %s" i reg_name) + + when (index_ /= ArmRegInvalid) + $ do + let Just reg_name = Capstone.csRegName handle index_ + putStrLn (printf "\t\t\toperands[%u].mem.index: REG = %s" i reg_name) + when (scale_ /= 1) + $ putStrLn (printf "\t\t\toperands[%u].mem.scale: %u" i scale_) + when (disp_ /= 0) + $ putStrLn (printf "\t\t\toperands[%u].mem.disp: 0x%x" i disp_) case lshift_ of Just ls -> putStrLn (printf "\t\t\toperands[%u].mem.lshift: 0x%x" i ls) Nothing -> pure () @@ -157,10 +150,10 @@ print_insn_detail handle insn = do subtracted_ = subtracted op vector_index_ = vectorIndex op - if neon_lane_ /= -1 - then putStrLn (printf "\t\toperands[%u].neon_lane = %u" neon_lane_) - else pure () + when (neon_lane_ /= -1) + $ putStrLn (printf "\t\toperands[%u].neon_lane = %u" neon_lane_) + -- TODO: wait for access enum -- case access_ of -- csAcRead -> -- putStrLn (printf "\t\toperands[%u].access: READ" i) @@ -172,16 +165,12 @@ print_insn_detail handle insn = do -- putStrLn (printf "\t\toperands[%u].access: READ | WRITE" i) -- putStrLn "" - if (fst shift_ /= ArmSftInvalid) && (snd shift_ /= 0) - then putStrLn (printf "\t\t\tShift: %s = %u" (show $ fst shift_) (snd shift_)) - else pure () - if vector_index_ /= -1 - then putStrLn (printf "\t\t\toperands[%u].vector_index = %u" i vector_index_) - else pure () - - if subtracted_ - then putStrLn (printf "\t\t\toperands[%u].subtracted = True" i) - else pure () + when ((fst shift_ /= ArmSftInvalid) && (snd shift_ /= 0)) + $ putStrLn (printf "\t\t\tShift: %s = %u" (show $ fst shift_) (snd shift_)) + when (vector_index_ /= -1) + $ putStrLn (printf "\t\t\toperands[%u].vector_index = %u" i vector_index_) + when subtracted_ + $ putStrLn (printf "\t\t\toperands[%u].subtracted = True" i) all_tests = @@ -264,6 +253,5 @@ main = do putStrLn $ "Code: " ++ to_hex (buffer dis) putStrLn "Disasm:" disasmIO $ dis - -- ioError (userError "Stop") to_hex code = unwords (map (printf "0x%02X") code) From ebc26b405293dc7df10e3410ee50f5ac82c5aa38 Mon Sep 17 00:00:00 2001 From: nganhkhoa Date: Sat, 3 Apr 2021 16:07:14 +0700 Subject: [PATCH 15/21] Update Arm, Arm64 and Tests --- examples/TestArm.hs | 165 ++++++++++++++++---------------- examples/TestArm64.hs | 80 +++++++++++++++- src/Hapstone/Internal/Arm.chs | 2 +- src/Hapstone/Internal/Arm64.chs | 4 +- 4 files changed, 161 insertions(+), 90 deletions(-) diff --git a/examples/TestArm.hs b/examples/TestArm.hs index b492fd5..ce373be 100644 --- a/examples/TestArm.hs +++ b/examples/TestArm.hs @@ -48,13 +48,9 @@ armv8 = print_insn_detail :: Capstone.Csh -> Capstone.CsInsn -> IO () print_insn_detail handle insn = do putStrLn ("0x" ++ a ++ ":\t" ++ m ++ "\t" ++ o) - case Capstone.detail insn of - Just detail -> do - case archInfo detail of - Just (Arm arch) -> do - printArchInsnInfo arch - _ -> pure() - _ -> pure () + Just detail <- pure $ Capstone.detail insn + Just (Arm arch) <- pure $ archInfo detail + printArchInsnInfo arch putStrLn "" where m = mnemonic insn @@ -62,6 +58,7 @@ print_insn_detail handle insn = do a = (showHex $ address insn) "" printArchInsnInfo arch = do + let operands = Arm.operands arch when (length operands > 0) $ putStrLn ("\topcount: " ++ ((show . length) operands)) mapM_ printOperandDetail $ zip [0..] operands @@ -93,84 +90,82 @@ print_insn_detail handle insn = do _ -> putStrLn (printf "\tMem-barrier: %s" (show $ memBarrier arch)) -- TODO: read/writer register, wait cs_reg_access - where - operands = Arm.operands arch - - printOperandDetail :: (Int, Arm.CsArmOp) -> IO () - printOperandDetail (i, op) = do - case value op of - Reg reg -> - let Just reg_name = Capstone.csRegName handle reg in - putStrLn (printf "\t\toperands[%u].type: REG = %s" i reg_name) - Sysreg reg -> - putStrLn (printf "\t\toperands[%u].type: SYSREG = %u" i reg) - Imm imm -> - putStrLn (printf "\t\toperands[%u].type: IMM = 0x%x" i imm) - CImm imm -> - putStrLn (printf "\t\toperands[%u].type: C-IMM = %u" i imm) - PImm imm -> - putStrLn (printf "\t\toperands[%u].type: P-IMM = %u" i imm) - Fp fp -> - putStrLn (printf "\t\toperands[%u].type: FP = %f" i fp) - Setend setend -> - case setend of - ArmSetendBe -> - putStrLn (printf "\t\toperands[%u].type: SETEND = be" i) - ArmSetendLe -> - putStrLn (printf "\t\toperands[%u].type: SETEND = le" i) - Mem mem -> do - let base_ = base mem - index_ = index mem - scale_ = scale mem - disp_ = disp mem - lshift_ = lshift mem - putStrLn (printf "\t\toperands[%u].type: MEM" i) - when (base_ /= ArmRegInvalid) - $ do - let Just reg_name = Capstone.csRegName handle base_ - putStrLn (printf "\t\t\toperands[%u].mem.base: REG = %s" i reg_name) - - when (index_ /= ArmRegInvalid) - $ do - let Just reg_name = Capstone.csRegName handle index_ - putStrLn (printf "\t\t\toperands[%u].mem.index: REG = %s" i reg_name) - when (scale_ /= 1) - $ putStrLn (printf "\t\t\toperands[%u].mem.scale: %u" i scale_) - when (disp_ /= 0) - $ putStrLn (printf "\t\t\toperands[%u].mem.disp: 0x%x" i disp_) - case lshift_ of - Just ls -> putStrLn (printf "\t\t\toperands[%u].mem.lshift: 0x%x" i ls) - Nothing -> pure () - _ -> - putStrLn (printf "\t\toperands[%u].type: UNKNOWN" i) - - let neon_lane_ = neon_lane op - access_ = access op - shift_ = shift op - subtracted_ = subtracted op - vector_index_ = vectorIndex op - - when (neon_lane_ /= -1) - $ putStrLn (printf "\t\toperands[%u].neon_lane = %u" neon_lane_) - - -- TODO: wait for access enum - -- case access_ of - -- csAcRead -> - -- putStrLn (printf "\t\toperands[%u].access: READ" i) - -- putStrLn "" - -- csAcWrite -> - -- putStrLn (printf "\t\toperands[%u].access: WRITE" i) - -- putStrLn "" - -- csAcReadWrite -> - -- putStrLn (printf "\t\toperands[%u].access: READ | WRITE" i) - -- putStrLn "" - - when ((fst shift_ /= ArmSftInvalid) && (snd shift_ /= 0)) - $ putStrLn (printf "\t\t\tShift: %s = %u" (show $ fst shift_) (snd shift_)) - when (vector_index_ /= -1) - $ putStrLn (printf "\t\t\toperands[%u].vector_index = %u" i vector_index_) - when subtracted_ - $ putStrLn (printf "\t\t\toperands[%u].subtracted = True" i) + where + printOperandDetail :: (Int, Arm.CsArmOp) -> IO () + printOperandDetail (i, op) = do + case value op of + Reg reg -> + let Just reg_name = Capstone.csRegName handle reg in + putStrLn (printf "\t\toperands[%u].type: REG = %s" i reg_name) + Sysreg reg -> + putStrLn (printf "\t\toperands[%u].type: SYSREG = %u" i reg) + Imm imm -> + putStrLn (printf "\t\toperands[%u].type: IMM = 0x%x" i imm) + CImm imm -> + putStrLn (printf "\t\toperands[%u].type: C-IMM = %u" i imm) + PImm imm -> + putStrLn (printf "\t\toperands[%u].type: P-IMM = %u" i imm) + Fp fp -> + putStrLn (printf "\t\toperands[%u].type: FP = %f" i fp) + Setend setend -> + case setend of + ArmSetendBe -> + putStrLn (printf "\t\toperands[%u].type: SETEND = be" i) + ArmSetendLe -> + putStrLn (printf "\t\toperands[%u].type: SETEND = le" i) + Mem mem -> do + let base_ = base mem + index_ = index mem + scale_ = scale mem + disp_ = disp mem + lshift_ = lshift mem + putStrLn (printf "\t\toperands[%u].type: MEM" i) + when (base_ /= ArmRegInvalid) + $ do + let Just reg_name = Capstone.csRegName handle base_ + putStrLn (printf "\t\t\toperands[%u].mem.base: REG = %s" i reg_name) + + when (index_ /= ArmRegInvalid) + $ do + let Just reg_name = Capstone.csRegName handle index_ + putStrLn (printf "\t\t\toperands[%u].mem.index: REG = %s" i reg_name) + when (scale_ /= 1) + $ putStrLn (printf "\t\t\toperands[%u].mem.scale: %u" i scale_) + when (disp_ /= 0) + $ putStrLn (printf "\t\t\toperands[%u].mem.disp: 0x%x" i disp_) + case lshift_ of + Just ls -> putStrLn (printf "\t\t\toperands[%u].mem.lshift: 0x%x" i ls) + Nothing -> pure () + _ -> + putStrLn (printf "\t\toperands[%u].type: UNKNOWN" i) + + let neon_lane_ = neon_lane op + access_ = access op + shift_ = shift op + subtracted_ = subtracted op + vector_index_ = vectorIndex op + + when (neon_lane_ /= -1) + $ putStrLn (printf "\t\toperands[%u].neon_lane = %u" neon_lane_) + + -- TODO: wait for access enum + -- case access_ of + -- csAcRead -> + -- putStrLn (printf "\t\toperands[%u].access: READ" i) + -- putStrLn "" + -- csAcWrite -> + -- putStrLn (printf "\t\toperands[%u].access: WRITE" i) + -- putStrLn "" + -- csAcReadWrite -> + -- putStrLn (printf "\t\toperands[%u].access: READ | WRITE" i) + -- putStrLn "" + + when ((fst shift_ /= ArmSftInvalid) && (snd shift_ /= 0)) + $ putStrLn (printf "\t\t\tShift: %s = %u" (show $ fst shift_) (snd shift_)) + when (vector_index_ /= -1) + $ putStrLn (printf "\t\t\toperands[%u].vector_index = %u" i vector_index_) + when subtracted_ + $ putStrLn (printf "\t\t\toperands[%u].subtracted = True" i) all_tests = diff --git a/examples/TestArm64.hs b/examples/TestArm64.hs index bebd1fb..8263f67 100644 --- a/examples/TestArm64.hs +++ b/examples/TestArm64.hs @@ -1,11 +1,13 @@ module Main where +import Control.Monad import Data.Word import Text.Printf import Numeric ( showHex ) import Hapstone.Capstone import Hapstone.Internal.Capstone as Capstone +import Hapstone.Internal.Arm64 as Arm64 arm_code = [ 0x09, 0x00, 0x38, 0xd5, 0xbf, 0x40, 0x00, 0xd5, 0x0c @@ -19,17 +21,91 @@ arm_code = ] print_insn_detail :: Capstone.Csh -> Capstone.CsInsn -> IO () -print_insn_detail handle insn = putStrLn ("0x" ++ a ++ ":\t" ++ m ++ "\t" ++ o) +print_insn_detail handle insn = do + putStrLn ("0x" ++ a ++ ":\t" ++ m ++ "\t" ++ o) + Just detail <- pure $ Capstone.detail insn + Just (Arm64 arch) <- pure $ archInfo detail + printArchInsnInfo arch + putStrLn "" where m = mnemonic insn o = opStr insn a = (showHex $ address insn) "" + printArchInsnInfo arch = do + let operands = Arm64.operands arch + when (length operands > 0) + $ putStrLn ("\topcount: " ++ ((show . length) operands)) + mapM_ printOperandDetail $ zip [0..] operands + when (updateFlags arch) + $ putStrLn "\tUpdate-flags: True" + when (writeback arch) + $ putStrLn "\tWrite-back: True" + case cc arch of + Arm64CcAl -> pure () + Arm64CcInvalid -> pure () + _ -> putStrLn $ printf "\tCode-condition: %s" (show $ cc arch) + + where + printOperandDetail :: (Int, Arm64.CsArm64Op) -> IO () + printOperandDetail (i, op) = do + case value op of + Reg reg -> do + let Just reg_name = Capstone.csRegName handle reg + putStrLn (printf "\t\toperands[%u].type: REG = %s" i reg_name) + Imm imm -> + putStrLn (printf "\t\toperands[%u].type: IMM = 0x%x" i imm) + CImm imm -> + putStrLn (printf "\t\toperands[%u].type: C-IMM = %u" i imm) + Fp fp -> + putStrLn (printf "\t\toperands[%u].type: FP = %f" i fp) + Mem mem -> do + let base_ = base mem + index_ = index mem + disp_ = disp mem + putStrLn (printf "\t\toperands[%u].type: MEM" i) + when (base_ /= Arm64RegInvalid) + $ do + let Just reg_name = Capstone.csRegName handle base_ + putStrLn (printf "\t\t\toperands[%u].mem.base: REG = %s" i reg_name) + when (index_ /= Arm64RegInvalid) + $ do + let Just reg_name = Capstone.csRegName handle index_ + putStrLn (printf "\t\t\toperands[%u].mem.index: REG = %s" i reg_name) + when (disp_ /= 0) + $ putStrLn (printf "\t\t\toperands[%u].mem.disp: 0x%x" i disp_) + Pstate state -> + putStrLn (printf "\t\toperands[%u].type: PSTATE = %s" i (show state)) + Sys sys -> + putStrLn (printf "\t\toperands[%u].type: SYS = 0x%x" i sys) + Prefetch prefetch -> + putStrLn (printf "\t\t\toperands[%u].type: PREFETCH = %s" i (show prefetch)) + Barrier barrier -> + putStrLn (printf "\t\toperands[%u].type: BARRIER = %s" i (show barrier)) + _ -> pure () + + let shift_ = shift op + ext_ = ext op + vess_ = vess op + vas_ = vas op + vector_index_ = vectorIndex op + + when ((fst shift_ /= Arm64SftInvalid) && (snd shift_ /= 0)) + $ putStrLn (printf "\t\t\tShift: type = %s, value = %u" (show $ fst shift_) (snd shift_)) + when (ext_ /= Arm64ExtInvalid) + $ putStrLn (printf "\t\t\tExt: %s" (show ext_)) + when (vas_ /= Arm64VasInvalid) + $ putStrLn (printf "\t\t\tVector Arrangement Specifier: %s" (show vas_)) + when (vess_ /= Arm64VessInvalid) + $ putStrLn (printf "\t\t\tVector Element Size Specifier: %s" (show vess_)) + when (vector_index_ /= -1) + $ putStrLn (printf "\t\t\tVector Index: %u" vector_index_) + all_tests = [ ( Disassembler { arch = Capstone.CsArchArm64 , modes = [Capstone.CsModeArm] , buffer = arm_code - , addr = 0x80001000 + , addr = 0x2c , num = 0 , Hapstone.Capstone.detail = True , skip = Just (defaultSkipdataStruct) diff --git a/src/Hapstone/Internal/Arm.chs b/src/Hapstone/Internal/Arm.chs index 3a9ec94..71e5aca 100644 --- a/src/Hapstone/Internal/Arm.chs +++ b/src/Hapstone/Internal/Arm.chs @@ -202,7 +202,7 @@ instance Storable CsArm where sizeOf _ = {#sizeof cs_arm#} alignment _ = {#alignof cs_arm#} peek p = CsArm - <$> ({#get cs_arm->usermode#} p) + <$> (toBool <$> (peekByteOff p {#offsetof cs_arm->usermode#} :: IO Word8)) <*> (fromIntegral <$> {#get cs_arm->vector_size#} p) <*> ((toEnum . fromIntegral) <$> {#get cs_arm->vector_data#} p) <*> ((toEnum . fromIntegral) <$> {#get cs_arm->cps_mode#} p) diff --git a/src/Hapstone/Internal/Arm64.chs b/src/Hapstone/Internal/Arm64.chs index 5faca6c..e54a166 100644 --- a/src/Hapstone/Internal/Arm64.chs +++ b/src/Hapstone/Internal/Arm64.chs @@ -224,8 +224,8 @@ instance Storable CsArm64 where alignment _ = {#alignof cs_arm64#} peek p = CsArm64 <$> (toEnum . fromIntegral <$> {#get cs_arm64->cc#} p) - <*> ({#get cs_arm64->update_flags#} p) - <*> ({#get cs_arm64->writeback#} p) + <*> (toBool <$> (peekByteOff p {#offsetof cs_arm64->update_flags#} :: IO Word8)) + <*> (toBool <$> (peekByteOff p {#offsetof cs_arm64->writeback#} :: IO Word8)) <*> do num <- fromIntegral <$> {#get cs_arm64->op_count#} p let ptr = plusPtr p {#offsetof cs_arm64.operands#} peekArray num ptr From adf0e6999e1274c7f86677a54d79b9cb0d02b081 Mon Sep 17 00:00:00 2001 From: nganhkhoa Date: Sat, 3 Apr 2021 16:09:29 +0700 Subject: [PATCH 16/21] Bool parsing fix --- src/Hapstone/Internal/M680x.chs | 2 +- src/Hapstone/Internal/Ppc.chs | 2 +- src/Hapstone/Internal/X86.chs | 4 ++-- 3 files changed, 4 insertions(+), 4 deletions(-) diff --git a/src/Hapstone/Internal/M680x.chs b/src/Hapstone/Internal/M680x.chs index dbfe297..970fc94 100644 --- a/src/Hapstone/Internal/M680x.chs +++ b/src/Hapstone/Internal/M680x.chs @@ -91,7 +91,7 @@ instance Storable M680xOpExt where alignment _ = {#alignof m680x_op_ext#} peek p = M680xOpExt <$> (fromIntegral <$> {#get m680x_op_ext->address#} p) - <*> ({#get m680x_op_ext->indirect#} p) + <*> (toBool <$> (peekByteOff p {#offsetof m680x_op_ext->indirect#} :: IO Word8)) poke p (M680xOpExt a i) = do {#set m680x_op_ext->address#} p (fromIntegral a) {#set m680x_op_ext->indirect#} p i diff --git a/src/Hapstone/Internal/Ppc.chs b/src/Hapstone/Internal/Ppc.chs index 789dbb9..9dd313a 100644 --- a/src/Hapstone/Internal/Ppc.chs +++ b/src/Hapstone/Internal/Ppc.chs @@ -139,7 +139,7 @@ instance Storable CsPpc where peek p = CsPpc <$> ((toEnum . fromIntegral) <$> {#get cs_ppc->bc#} p) <*> ((toEnum . fromIntegral) <$> {#get cs_ppc->bh#} p) - <*> {#get cs_ppc->update_cr0#} p + <*> (toBool <$> (peekByteOff p {#offsetof cs_ppc->update_cr0#} :: IO Word8)) <*> do num <- fromIntegral <$> {#get cs_ppc->op_count#} p let ptr = plusPtr p {#offsetof cs_ppc.operands#} peekArray num ptr diff --git a/src/Hapstone/Internal/X86.chs b/src/Hapstone/Internal/X86.chs index 3e4a3ee..dcfa0a6 100644 --- a/src/Hapstone/Internal/X86.chs +++ b/src/Hapstone/Internal/X86.chs @@ -207,7 +207,7 @@ instance Storable CsX86Op where <*> (fromIntegral <$> {#get cs_x86_op->size#} p) <*> (fromIntegral <$> {#get cs_x86_op->access#} p) <*> ((toEnum . fromIntegral) <$> {#get cs_x86_op->avx_bcast#} p) - <*> ({#get cs_x86_op->avx_zero_opmask#} p) + <*> (toBool <$> (peekByteOff p {#offsetof cs_x86_op->avx_zero_opmask#} :: IO Word8)) poke p (CsX86Op val s a ab az) = do let regP = plusPtr p {#offsetof cs_x86_op->reg#} immP = plusPtr p {#offsetof cs_x86_op->imm#} @@ -306,7 +306,7 @@ instance Storable CsX86 where <*> ((toEnum . fromIntegral) <$> {#get cs_x86->xop_cc#} p) <*> ((toEnum . fromIntegral) <$> {#get cs_x86->sse_cc#} p) <*> ((toEnum . fromIntegral) <$> {#get cs_x86->avx_cc#} p) - <*> ({#get cs_x86->avx_sae#} p) + <*> (toBool <$> (peekByteOff p {#offsetof cs_x86->avx_sae#} :: IO Word8)) <*> ((toEnum . fromIntegral) <$> {#get cs_x86->avx_rm#} p) <*> (fromIntegral <$> {#get cs_x86->eflags#} p) <*> do num <- (fromIntegral <$> {#get cs_x86->op_count#} p) From 5656b8701d74095ddf2ea39fd65cd2f15fd32de1 Mon Sep 17 00:00:00 2001 From: nganhkhoa Date: Sun, 4 Apr 2021 23:49:04 +0700 Subject: [PATCH 17/21] Test Evm --- examples/TestEvm.hs | 23 ++++++++++++++++++++++- 1 file changed, 22 insertions(+), 1 deletion(-) diff --git a/examples/TestEvm.hs b/examples/TestEvm.hs index 8411f68..09f3431 100644 --- a/examples/TestEvm.hs +++ b/examples/TestEvm.hs @@ -1,11 +1,13 @@ module Main where +import Control.Monad import Data.Word import Text.Printf import Numeric ( showHex ) import Hapstone.Capstone import Hapstone.Internal.Capstone as Capstone +import Hapstone.Internal.Evm as Evm evm_code = [ 0x60 @@ -14,12 +16,31 @@ evm_code = ] print_insn_detail :: Capstone.Csh -> Capstone.CsInsn -> IO () -print_insn_detail handle insn = putStrLn ("0x" ++ a ++ ":\t" ++ m ++ "\t" ++ o) +print_insn_detail handle insn = do + putStrLn ("0x" ++ a ++ ":\t" ++ m ++ "\t" ++ o) + Just detail <- pure $ Capstone.detail insn + Just (Evm arch) <- pure $ archInfo detail + igroups <- pure $ groups detail + when (pop arch > 0) + $ putStrLn $ printf "\tPop: %u" (pop arch) + when (push arch > 0) + $ putStrLn $ printf "\tPush: %u" (pop arch) + when (fee arch > 0) + $ putStrLn $ printf "\tGas fee: %u" (pop arch) + when (length igroups > 0) + $ do + putStr "\tThis instruction belongs to groups:" + mapM_ printGroup igroups + putStrLn "" where m = mnemonic insn o = opStr insn a = (showHex $ address insn) "" + printGroup g = do + Just name <- pure $ csGroupName handle g + putStr $ printf " %s" name + all_tests = [ ( Disassembler { arch = Capstone.CsArchEvm , modes = [] From 6cdc95fa2b1fcbccb3a395fa4555633549182633 Mon Sep 17 00:00:00 2001 From: nganhkhoa Date: Mon, 5 Apr 2021 00:45:38 +0700 Subject: [PATCH 18/21] Test M680x --- examples/TestM680x.hs | 70 ++++++++++++++++++++++++++++++++++++++++++- 1 file changed, 69 insertions(+), 1 deletion(-) diff --git a/examples/TestM680x.hs b/examples/TestM680x.hs index d787108..b1e4fda 100644 --- a/examples/TestM680x.hs +++ b/examples/TestM680x.hs @@ -1,11 +1,14 @@ module Main where +import Control.Monad +import Data.Bits ( (.&.) ) import Data.Word import Text.Printf import Numeric ( showHex ) import Hapstone.Capstone import Hapstone.Internal.Capstone as Capstone +import Hapstone.Internal.M680x as M680x m6800_code = @@ -97,12 +100,77 @@ hd6309_code = print_insn_detail :: Capstone.Csh -> Capstone.CsInsn -> IO () -print_insn_detail handle insn = putStrLn ("0x" ++ a ++ ":\t" ++ m ++ "\t" ++ o) +print_insn_detail handle insn = do + putStrLn ("0x" ++ a ++ ":\t" ++ m ++ "\t" ++ o) + Just detail <- pure $ Capstone.detail insn + Just (M680x arch) <- pure $ archInfo detail + igroups <- pure $ groups detail + printArchInsnInfo arch + when (length igroups /= 0) + $ putStrLn $ printf "\tgroups_count: %u" (length igroups) + putStrLn "" where m = mnemonic insn o = opStr insn a = (showHex $ address insn) "" + printArchInsnInfo arch = do + let operands = M680x.operands arch + mapM_ printOperandDetail $ zip [0..] operands + where + printOperandDetail :: (Int, M680x.CsM680xOp) -> IO () + printOperandDetail (i, op) = do + case value op of + Imm imm -> do + putStrLn $ printf "\t\toperands[%u].type: IMMEDIATE = #%d" i imm + Reg reg -> do + let f = flags arch + comment1 = i == 0 && (f .&. 1 == 1) + comment2 = i == 1 && (f .&. 2 == 1) + Just reg_name = Capstone.csRegName handle reg + if (comment1 || comment2) + then putStrLn $ printf "\t\toperands[%u].type: REGISTER = %s (in mnemonic)" i reg_name + else putStrLn $ printf "\t\toperands[%u].type: REGISTER = %s" i reg_name + Idx idx -> do + let post_pre = if ((idxFlags idx) .&. 4 == 1) + then "post" + else "pre" + inc_dec = if (incDec idx > 0) + then "increment" + else "decrement" + Just base_reg = Capstone.csRegName handle $ baseReg idx + Just offset_reg = Capstone.csRegName handle $ offsetReg idx + if ((idxFlags idx) .&. 1 == 1) + then putStrLn $ printf "\t\toperands[%u].type: INDEXED INDIRECT" i + else putStrLn $ printf "\t\toperands[%u].type: INDEXED" i + when (baseReg idx /= M680xRegInvalid) + $ putStrLn $ printf "\t\t\tbase register: %s" base_reg + when (offsetReg idx /= M680xRegInvalid) + $ putStrLn $ printf "\t\t\tbase register: %s" offset_reg + when (offsetBits idx /= 0 && offsetReg idx == M680xRegInvalid && incDec idx == 0) + $ do + putStrLn $ printf "\t\t\toffset: %u" (idxOffset idx) + when (baseReg idx == M680xRegPc) + $ putStrLn $ printf "\t\t\toffset address: 0x%04x" (offsetAddr idx) + putStrLn $ printf "\t\t\toffset bits: %u" (offsetBits idx) + when (incDec idx /= 0) + $ putStrLn $ printf "\t\t\t%s %s: %d" post_pre inc_dec (abs $ incDec idx) + Rel rel -> + putStrLn $ printf "\t\toperands[%u].type: RELATIVE = 0x%04x" i (relAddress rel) + Ext ext -> + if (indirect ext) + then putStrLn $ printf "\t\toperands[%u].type: EXTENDED INDIRECT = 0x%04x" i (extAddress ext) + else putStrLn $ printf "\t\toperands[%u].type: EXTENDED = 0x%04x" i (extAddress ext) + Addr addr -> + putStrLn $ printf "\t\toperands[%u].type: DIRECT = 0x%02x" i addr + Val val -> + putStrLn $ printf "\t\toperands[%u].type: CONSTANT = %u" i val + _ -> pure () + when (size op /= 0) + $ putStrLn $ printf "\t\t\tsize: %d" (size op) + when (access op /= 0) + $ putStrLn $ printf "\t\t\taccess: %d" (access op) + all_tests = [ ( Disassembler { arch = Capstone.CsArchM680x , modes = [CsModeM680x6301] From 4aeb7be6366e0fd059d5c72354181009b34c402b Mon Sep 17 00:00:00 2001 From: nganhkhoa Date: Mon, 5 Apr 2021 00:57:43 +0700 Subject: [PATCH 19/21] Test Mips --- examples/TestMips.hs | 30 +++++++++++++++++++++++++++++- 1 file changed, 29 insertions(+), 1 deletion(-) diff --git a/examples/TestMips.hs b/examples/TestMips.hs index 7c2ea81..eb9cce5 100644 --- a/examples/TestMips.hs +++ b/examples/TestMips.hs @@ -1,11 +1,13 @@ module Main where +import Control.Monad import Data.Word import Text.Printf import Numeric ( showHex ) import Hapstone.Capstone import Hapstone.Internal.Capstone as Capstone +import Hapstone.Internal.Mips as Mips mips_code = [ 0x0C, 0x10, 0x00, 0x97, 0x00, 0x00, 0x00, 0x00, 0x24 @@ -27,12 +29,38 @@ mips_32r6 = ] print_insn_detail :: Capstone.Csh -> Capstone.CsInsn -> IO () -print_insn_detail handle insn = putStrLn ("0x" ++ a ++ ":\t" ++ m ++ "\t" ++ o) +print_insn_detail handle insn = do + putStrLn ("0x" ++ a ++ ":\t" ++ m ++ "\t" ++ o) + Just detail <- pure $ Capstone.detail insn + Just (Mips arch) <- pure $ archInfo detail + printArchInsnInfo arch + putStrLn "" where m = mnemonic insn o = opStr insn a = (showHex $ address insn) "" + printArchInsnInfo (CsMips operands) = do + putStrLn ("\topcount: " ++ ((show . length) operands)) + mapM_ printOperandDetail $ zip [0..] operands + where + printOperandDetail :: (Int, Mips.CsMipsOp) -> IO () + printOperandDetail (i, op) = + case op of + Reg reg -> do + let Just reg_name = Capstone.csRegName handle reg + putStrLn $ printf "\t\toperands[%u].type: REG = %s" i reg_name + Imm imm -> + putStrLn $ printf "\t\toperands[%u].type: IMM = 0x%x" i imm + Mem mem -> do + putStrLn $ printf "\t\toperands[%u].type: MEM" i + when (base mem /= MipsRegInvalid) + $ do + let Just reg_name = Capstone.csRegName handle (base mem) + putStrLn $ printf "\t\t\toperands[%u].mem.base: REG = %s" i reg_name + when (disp mem /= 0) + $ putStrLn $ printf "\t\t\toperands[%u].mem.disp: 0x%x" i (disp mem) + all_tests = [ ( Disassembler { arch = Capstone.CsArchMips , modes = [CsModeBigEndian, CsModeMips32] From 889e16412c6c38eae9588053476c8140dd04dfc6 Mon Sep 17 00:00:00 2001 From: nganhkhoa Date: Mon, 5 Apr 2021 22:14:08 +0700 Subject: [PATCH 20/21] Test M68k --- examples/TestM68k.hs | 57 +++++++++++++++++++++++++++++++++- src/Hapstone/Internal/M68k.chs | 20 +++++++----- 2 files changed, 69 insertions(+), 8 deletions(-) diff --git a/examples/TestM68k.hs b/examples/TestM68k.hs index c4bed1b..7e8e697 100644 --- a/examples/TestM68k.hs +++ b/examples/TestM68k.hs @@ -1,11 +1,13 @@ module Main where +import Control.Monad import Data.Word import Text.Printf import Numeric ( showHex ) import Hapstone.Capstone import Hapstone.Internal.Capstone as Capstone +import Hapstone.Internal.M68k as M68k m68k_code = [ 0x4c, 0x00, 0x54, 0x04, 0x48, 0xe7, 0xe0, 0x30, 0x4c @@ -19,12 +21,65 @@ m68k_code = print_insn_detail :: Capstone.Csh -> Capstone.CsInsn -> IO () -print_insn_detail handle insn = putStrLn ("0x" ++ a ++ ":\t" ++ m ++ "\t" ++ o) +print_insn_detail handle insn = do + putStrLn ("0x" ++ a ++ ":\t" ++ m ++ "\t" ++ o) + Just detail <- pure $ Capstone.detail insn + Just (M68k arch) <- pure $ archInfo detail + igroups <- pure $ groups detail + printArchInsnInfo arch + when (length igroups /= 0) + $ putStrLn $ printf "\tgroups_count: %u" (length igroups) + putStrLn "" where m = mnemonic insn o = opStr insn a = (showHex $ address insn) "" + printArchInsnInfo arch = do + let operands = M68k.operands arch + putStrLn ("\topcount: " ++ ((show . length) operands)) + mapM_ printOperandDetail $ zip [0..] operands + where + printOperandDetail :: (Int, M68k.CsM68kOp) -> IO () + printOperandDetail (i, op) = + case value op of + Imm imm -> + putStrLn $ printf "\t\toperands[%u].type: IMM = 0x%x" i imm + DImm dimm -> do + putStrLn $ printf "\t\toperands[%u].type: FP_DOUBLE" i + putStrLn $ printf "\t\toperands[%u].simm: %lf" i dimm + SImm simm -> do + putStrLn $ printf "\t\toperands[%u].type: FP_SINGLE" i + putStrLn $ printf "\t\toperands[%u].simm: %f" i simm + Reg reg -> do + let Just reg_name = Capstone.csRegName handle reg + putStrLn $ printf "\t\toperands[%u].type: REG = %s" i reg_name + BrDisp brdisp -> do + putStrLn $ printf "\t\toperands[%u].br_disp.disp: 0x%x" i (brDisp brdisp) + putStrLn $ printf "\t\toperands[%u].br_disp.disp_size: %s" i (show $ brSize brdisp) + Mem mem -> do + let baseReg_ = baseReg mem + indexReg_ = indexReg mem + putStrLn $ printf "\t\toperands[%u].type: MEM" i + when (baseReg_ /= M68kRegInvalid) + $ do + let Just reg_name = Capstone.csRegName handle baseReg_ + putStrLn $ printf "\t\t\toperands[%u].mem.base: REG = %s" i reg_name + when (indexReg_ /= M68kRegInvalid) + $ do + let Just reg_name = Capstone.csRegName handle indexReg_ + putStrLn $ printf "\t\t\toperands[%u].mem.index: REG = %s" i reg_name + if (indexSize mem > 0) + then putStrLn $ printf "\t\t\toperands[%u].mem.index: size = l" i + else putStrLn $ printf "\t\t\toperands[%u].mem.index: size = w" i + when (memDisp mem /= 0) + $ putStrLn $ printf "\t\t\toperands[%u].mem.disp: 0x%x" i (memDisp mem) + when (scale mem /= 0) + $ putStrLn $ printf "\t\t\toperands[%u].mem.scale: %d" i (scale mem) + putStrLn $ printf "\t\taddress mode: %s" (show $ addressMode op) + RegPair (reg1, reg2) -> pure () + _ -> pure () + all_tests = [ ( Disassembler { arch = Capstone.CsArchM68k , modes = [CsModeBigEndian, CsModeM68k040] diff --git a/src/Hapstone/Internal/M68k.chs b/src/Hapstone/Internal/M68k.chs index b96ff81..26131ab 100644 --- a/src/Hapstone/Internal/M68k.chs +++ b/src/Hapstone/Internal/M68k.chs @@ -107,13 +107,13 @@ data CsM68kOpValue | SImm Float | Reg M68kReg | RegPair (M68kReg, M68kReg) + | Mem M68kOpMemStruct + | BrDisp M68kOpBrDispStruct | CsM68kOpInvalid deriving (Show, Eq) data CsM68kOp = CsM68kOp { value :: CsM68kOpValue - , mem :: M68kOpMemStruct - , br :: M68kOpBrDispStruct , registerBits :: Word32 , addressMode :: M68kAddressMode } deriving (Show, Eq) @@ -127,6 +127,8 @@ instance Storable CsM68kOp where let regP = plusPtr p {#offsetof cs_m68k_op->reg#} let reg0P = plusPtr p {#offsetof cs_m68k_op->reg_pair.reg_0#} let reg1P = plusPtr p {#offsetof cs_m68k_op->reg_pair.reg_1#} + let memP = (plusPtr p {#offsetof cs_m68k_op->mem#}) + let brP = (plusPtr p {#offsetof cs_m68k_op->br_disp#}) case toEnum t of M68kOpImm -> (Imm . fromIntegral) <$> {#get cs_m68k_op->imm#} p M68kOpFpDouble -> (DImm . realToFrac) <$> {#get cs_m68k_op->dimm#} p @@ -136,14 +138,12 @@ instance Storable CsM68kOp where let r0 = (toEnum . fromIntegral) <$> {#get cs_m68k_op->reg_pair.reg_0#} p let r1 = (toEnum . fromIntegral) <$> {#get cs_m68k_op->reg_pair.reg_1#} p RegPair <$> ((,) <$> r0 <*> r1) + M68kOpMem -> Mem <$> peek memP + M68kOpBrDisp -> BrDisp <$> peek brP _ -> return CsM68kOpInvalid - <*> peek (plusPtr p {#offsetof cs_m68k_op->mem#}) - <*> peek (plusPtr p {#offsetof cs_m68k_op->br_disp#}) <*> (fromIntegral <$> {#get cs_m68k_op->register_bits#} p) <*> ((toEnum . fromIntegral) <$> {#get cs_m68k_op->address_mode#} p) - poke p (CsM68kOp v m b r a) = do - poke (plusPtr p {#offsetof cs_m68k_op->mem#}) m - poke (plusPtr p {#offsetof cs_m68k_op->br_disp#}) b + poke p (CsM68kOp v r a) = do {#set cs_m68k_op->address_mode#} p (fromIntegral $ fromEnum a) {#set cs_m68k_op->register_bits#} p (fromIntegral r) let regP = plusPtr p {#offsetof cs_m68k_op->reg#} @@ -152,6 +152,8 @@ instance Storable CsM68kOp where simmP = plusPtr p {#offsetof cs_m68k_op->simm#} reg0P = plusPtr p {#offsetof cs_m68k_op->reg_pair.reg_0#} reg1P = plusPtr p {#offsetof cs_m68k_op->reg_pair.reg_1#} + memP = (plusPtr p {#offsetof cs_m68k_op->mem#}) + brP = (plusPtr p {#offsetof cs_m68k_op->br_disp#}) setType = {#set cs_m68k_op->type#} p . fromIntegral . fromEnum case v of Reg r -> do @@ -170,6 +172,10 @@ instance Storable CsM68kOp where poke reg0P (fromIntegral $ fromEnum r0 :: CUInt) poke reg1P (fromIntegral $ fromEnum r1 :: CUInt) setType M68kOpRegPair + Mem mem -> + poke memP mem + BrDisp brdisp -> + poke brP brdisp _ -> setType M68kOpInvalid {#enum m68k_cpu_size as M68kCpuSize {underscoreToCase} From b9096f7ffeb2de6e22df8300d57b2da9b575beb7 Mon Sep 17 00:00:00 2001 From: nganhkhoa Date: Mon, 5 Apr 2021 22:40:23 +0700 Subject: [PATCH 21/21] Test Ppc --- examples/TestPpc.hs | 116 ++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 116 insertions(+) create mode 100644 examples/TestPpc.hs diff --git a/examples/TestPpc.hs b/examples/TestPpc.hs new file mode 100644 index 0000000..a537540 --- /dev/null +++ b/examples/TestPpc.hs @@ -0,0 +1,116 @@ +module Main where + +import Control.Monad +import Data.Bits ( (.&.) ) +import Data.Word +import Text.Printf +import Numeric ( showHex ) + +import Hapstone.Capstone +import Hapstone.Internal.Capstone as Capstone +import Hapstone.Internal.Ppc as Ppc + + +ppc_code = + [ 0x43, 0x20, 0x0c, 0x07, 0x41, 0x56, 0xff, 0x17, 0x80 + , 0x20, 0x00, 0x00, 0x80, 0x3f, 0x00, 0x00, 0x10, 0x43 + , 0x23, 0x0e, 0xd0, 0x44, 0x00, 0x80, 0x4c, 0x43, 0x22 + , 0x02, 0x2d, 0x03, 0x00, 0x80, 0x7c, 0x43, 0x20, 0x14 + , 0x7c, 0x43, 0x20, 0x93, 0x4f, 0x20, 0x00, 0x21, 0x4c + , 0xc8, 0x00, 0x21, 0x40, 0x82, 0x00, 0x14 + ] + +ppc_code2 = + [ 0x10, 0x60, 0x2a, 0x10, 0x10, 0x64, 0x28, 0x88, 0x7c + , 0x4a, 0x5d, 0x0f + ] + +print_insn_detail :: Capstone.Csh -> Capstone.CsInsn -> IO () +print_insn_detail handle insn = do + putStrLn ("0x" ++ a ++ ":\t" ++ m ++ "\t" ++ o) + Just detail <- pure $ Capstone.detail insn + Just (Ppc arch) <- pure $ archInfo detail + igroups <- pure $ groups detail + printArchInsnInfo arch + when (length igroups /= 0) + $ putStrLn $ printf "\tgroups_count: %u" (length igroups) + putStrLn "" + where + m = mnemonic insn + o = opStr insn + a = (showHex $ address insn) "" + + printArchInsnInfo arch = do + let operands = Ppc.operands arch + mapM_ printOperandDetail $ zip [0..] operands + when (bc arch /= PpcBcInvalid) + $ putStrLn $ printf "\tBranch code: %s" (show $ bc arch) + when (bh arch /= PpcBhInvalid) + $ putStrLn $ printf "\tBranch hint: %s" (show $ bh arch) + when (updateCr0 arch) + $ putStrLn "\tUpdate-CR0: True" + where + printOperandDetail :: (Int, Ppc.CsPpcOp) -> IO () + printOperandDetail (i, op) = do + case op of + Imm imm -> do + putStrLn $ printf "\t\toperands[%u].type: IMM = #%d" i imm + Reg reg -> do + let Just reg_name = Capstone.csRegName handle reg + putStrLn $ printf "\t\toperands[%u].type: REG = %s" i reg_name + Mem mem -> do + putStrLn $ printf "\t\toperands[%u].type: MEM" i + when (base mem /= PpcRegInvalid) + $ do + let Just reg_name = Capstone.csRegName handle $ base mem + putStrLn $ printf "\t\t\toperands[%u].mem.base: REG = %s" i reg_name + when (disp mem /= 0) + $ putStrLn $ printf "\t\t\toperands[%u].mem.disp: 0x%x" i (disp mem) + Crx crx -> do + putStrLn $ printf "\t\toperands[%u].type: CRX" i + putStrLn $ printf "\t\t\toperands[%u].crx.scale: = %u" i (scale crx) + when (reg crx /= PpcRegInvalid) + $ do + let Just reg_name = Capstone.csRegName handle $ reg crx + putStrLn $ printf "\t\t\toperands[%u].crx.reg: REG = %s" i reg_name + putStrLn $ printf "\t\t\toperands[%u].crx.cond: %s" i (show $ cond crx) + _ -> pure () + +all_tests = + [ ( Disassembler { arch = Capstone.CsArchPpc + , modes = [CsModeBigEndian] + , buffer = ppc_code + , addr = 0x1000 + , num = 0 + , Hapstone.Capstone.detail = True + , skip = Just (defaultSkipdataStruct) + , action = print_insn_detail + } + , "PPC-64" + ) + , ( Disassembler { arch = Capstone.CsArchPpc + , modes = [CsModeBigEndian, CsModeQpx] + , buffer = ppc_code2 + , addr = 0x1000 + , num = 0 + , Hapstone.Capstone.detail = True + , skip = Just (defaultSkipdataStruct) + , action = print_insn_detail + } + , "PPC-64 + QPX" + ) + ] + +main :: IO () +main = do + mapM test_disasm all_tests + pure () + where + test_disasm (dis, platform) = do + putStrLn $ replicate 16 '*' + putStrLn $ "Platform: " ++ platform + putStrLn $ "Code: " ++ to_hex (buffer dis) + putStrLn "Disasm:" + disasmIO $ dis + + to_hex code = unwords (map (printf "0x%02X") code)