hdis86 0.1 → 0.2

raw patch · 9 files changed

+304/−42 lines, 9 filesdep +QuickCheckPVP ok

version bump matches the API change (PVP)

Dependencies added: QuickCheck

API changes (from Hackage documentation)

Files

• Hdis86.hs +3/−2
• Hdis86/C.hsc +1/−1
• Hdis86/IO.hs +13/−1
• Hdis86/Incremental.hs +60/−0
• Hdis86/Internal/Map.hs +1/−2
• Hdis86/Pure.hs +3/−28
• Hdis86/Types.hs +121/−4
• hdis86.cabal +33/−4
• tools/test_lazy_bytestring.hs +69/−0

@@ -2,8 +2,9 @@ -- -- Exports the simplest, most high-level interface. module Hdis86-  ( module Hdis86.Types-  , module Hdis86.Pure+  ( disassemble+  , disassembleMetadata+  , module Hdis86.Types   ) where  import Hdis86.Types

@@ -5,7 +5,7 @@ -- | Bare import of the @udis86@ C library. -- -- This module is not recommended for most users. What you see is what you get.--- The modules @'Hdis86.IO'@ and @'Hdis86.Pure'@ provide a more Haskell-friendly+-- The modules "Hdis86.IO" and "Hdis86.Pure" provide a more Haskell-friendly -- interface to the same functionality. -- -- If you want to use this module, see the @udis86@ documentation: <http://udis86.sourceforge.net>

@@ -12,7 +12,7 @@ -- this module's API is thoroughly imperative, but uses -- Haskellish types and automatic resource management. ----- For a higher-level, @IO@-free API, see @'Hdis86.Pure'@.+-- For a higher-level, @IO@-free API, see "Hdis86.Pure". -- -- This module is fully thread-safe: any number of threads -- may manipulate one or several @'UD'@ objects at the same@@ -36,6 +36,7 @@   , getInstruction   , getLength, getOffset   , getHex, getBytes, getAssembly+  , getMetadata      -- * Configuration   , setConfig@@ -310,6 +311,17 @@ getAssembly :: UD -> IO String getAssembly = flip withUDPtr $ \p ->   C.insn_asm p >>= peekCString++-- | Get all metadata about the current instruction,+-- along with the instruction itself.+getMetadata :: UD -> IO Metadata+getMetadata ud = Metadata+  <$> getOffset      ud+  <*> getLength      ud+  <*> getHex         ud+  <*> getBytes       ud+  <*> getAssembly    ud+  <*> getInstruction ud  -- | Skip the next /n/ bytes of the input. skip :: UD -> Word -> IO ()

@@ -0,0 +1,60 @@+-- | Incremental pure disassembly.+module Hdis86.Incremental+  ( disassembleOne+  , disassembleLazy+  ) where++import Hdis86.Types+import qualified Hdis86.Pure as P+import qualified Hdis86.IO   as I++import Data.Maybe++import System.IO.Unsafe ( unsafePerformIO )++import qualified Data.ByteString      as BS+import qualified Data.ByteString.Lazy as BL++disOne :: Config -> BS.ByteString -> Maybe Metadata+disOne cfg bs = unsafePerformIO $ do+  ud <- I.newUD+  I.setInputBuffer ud bs+  I.setConfig      ud cfg+  n <- I.advance ud+  case n of+    Just _  -> Just `fmap` I.getMetadata ud+    Nothing -> return Nothing++-- | Split a @'BS.ByteString'@ into an instruction and the remaining+-- @'BS.ByteString'@.+--+-- Returns @'Nothing'@ if the input is empty or contains an+-- incomplete instruction.+disassembleOne :: Config -> BS.ByteString -> Maybe (Metadata, BS.ByteString)+disassembleOne cfg bs = disOne cfg bs >>= (fmap getRem . getMD) where+  -- invalid instruction: distinguish from incomplete instruction+  -- by appending 0x90 = nop+  getMD m@Metadata { mdInst  = i0@Inst { inOpcode = Iinvalid },+                     mdBytes = ibs }+    = case P.disassemble cfg (ibs `BS.snoc` 0x90) of+        [i1, Inst [] Inop []] | i0 == i1  -> Just m+        _ -> Nothing++  getMD  m = Just m++  getRem m = (m, BS.drop (fromIntegral $ mdLength m) bs)++-- | Disassemble a lazy @'BL.ByteString'@.+--+-- The output is produced lazily.+disassembleLazy :: Config -> BL.ByteString -> [Metadata]+disassembleLazy cfg = go (cfgOrigin cfg) BS.empty . BL.toChunks where+  go n bs chunks = let newcfg = cfg { cfgOrigin = n } in+    case disassembleOne newcfg bs of+      Just (md, bsrem) -> md : go nn bsrem chunks where+        nn = n + fromIntegral (mdLength md)++      Nothing -> case chunks of+        (x:xs) -> go n (bs `BS.append` x) xs+        -- end of input; produce a final incomplete instruction if any+        []     -> maybeToList $ disOne newcfg bs

@@ -1,5 +1,4 @@-{-# OPTIONS_HADDOCK-    hide #-}+-- | Internal module; use at your own risk. module Hdis86.Internal.Map   ( UDTM, makeUDTM, lookupUDTM   , register, opcode

@@ -1,11 +1,8 @@-{-# LANGUAGE-    DeriveDataTypeable #-}- -- | Interface to the @udis86@ disassembler. -- -- This is the simplest, most high-level interface. ----- See @'Hdis86.IO'@ if you need more control or performance.+-- See "Hdis86.IO" if you need more control or performance. module Hdis86.Pure   ( -- * Simple disassembly     disassemble@@ -19,12 +16,6 @@ import Hdis86.IO ( UD ) import qualified Hdis86.IO as I -import Data.Typeable ( Typeable )-import Data.Data     ( Data )--import Control.Applicative-import Data.Word- import System.IO.Unsafe ( unsafePerformIO )  import qualified Data.ByteString as BS@@ -40,30 +31,14 @@ -- | Disassemble machine code. -- -- Common values for @'Config'@ such as @'intel32'@ or @'amd64'@--- are provided in @'Hdis86.Types'@.+-- are provided in "Hdis86.Types". -- -- The output is produced lazily. disassemble :: Config -> BS.ByteString -> [Instruction] disassemble = disWith I.getInstruction --- | An instruction with full metadata.-data Metadata = Metadata-  { mdOffset   :: Word64         -- ^ Offset of the start of this instruction-  , mdLength   :: Word           -- ^ Length of this instruction in bytes-  , mdHex      :: String         -- ^ Hexadecimal representation of this instruction-  , mdBytes    :: BS.ByteString  -- ^ Bytes that make up this instruction-  , mdAssembly :: String         -- ^ Assembly code for this instruction-  , mdInst     :: Instruction    -- ^ The instruction itself-  } deriving (Eq, Ord, Show, Read, Typeable, Data)- -- | Disassemble machine code, with full metadata. -- -- The output is produced lazily. disassembleMetadata :: Config -> BS.ByteString -> [Metadata]-disassembleMetadata = disWith $ \ud -> Metadata-  <$> I.getOffset      ud-  <*> I.getLength      ud-  <*> I.getHex         ud-  <*> I.getBytes       ud-  <*> I.getAssembly    ud-  <*> I.getInstruction ud+disassembleMetadata = disWith I.getMetadata

@@ -1,5 +1,8 @@ {-# LANGUAGE-    DeriveDataTypeable #-}+    DeriveDataTypeable+  , ScopedTypeVariables #-}+{-# OPTIONS_GHC+    -fno-warn-orphans #-}  -- | Types provided by the disassembler. module Hdis86.Types@@ -16,6 +19,9 @@     -- * Word sizes   , WordSize(..), wordSize, bitsInWord +    -- * Instruction with metadata+  , Metadata(..)+     -- * Configuration   , Config(..)   , Vendor(..), CPUMode(..), Syntax(..)@@ -33,7 +39,12 @@ import Data.Data     ( Data ) import Data.Word import Data.Int+import Control.Applicative hiding ( Const ) +import qualified Data.ByteString as BS+import qualified Text.Read       as R+import qualified Test.QuickCheck as Q+ -- | Machine word sizes. -- -- Some fields, such as immediate operands, come in different@@ -151,10 +162,27 @@ -- -- The destination @'Operand'@ (if any) will precede the source -- @'Operand'@s.-data Instruction-  = Inst [Prefix] Opcode [Operand]-  deriving (Eq, Ord, Show, Read, Typeable, Data)+data Instruction = Inst+  { inPrefixes :: [Prefix]+  , inOpcode   :: Opcode+  , inOperands :: [Operand]+  } deriving (Eq, Ord, Typeable, Data) +instance Show Instruction where+  showsPrec p (Inst pfx opc opr) = showParen (p >= 11) body+    where+      body = foldr (.) id+        [("Inst "++), showsPrec 11 pfx, (" "++),+         showsPrec 11 opc, (" "++), showsPrec 11 opr]++instance Read Instruction where+  readsPrec d = R.readParen (d > 10) $ \r ->+    [(Inst pfx opc opr, xd)+      | ("Inst", xa) <- R.lex r+      , (pfx, xb) <- readsPrec 11 xa+      , (opc, xc) <- readsPrec 11 xb+      , (opr, xd) <- readsPrec 11 xc]+ -- | Prefixes, used to modify an instruction. data Prefix   = Seg Segment  -- ^ Segment override@@ -198,6 +226,16 @@   , iValue :: t         -- ^ Immediate value, e.g @'Int64'@ or @'Word64'@   } deriving (Eq, Ord, Show, Read, Typeable, Data) +-- | An instruction with full metadata.+data Metadata = Metadata+  { mdOffset   :: Word64         -- ^ Offset of the start of this instruction+  , mdLength   :: Word           -- ^ Length of this instruction in bytes+  , mdHex      :: String         -- ^ Hexadecimal representation of this instruction+  , mdBytes    :: BS.ByteString  -- ^ Bytes that make up this instruction+  , mdAssembly :: String         -- ^ Assembly code for this instruction+  , mdInst     :: Instruction    -- ^ The instruction itself+  } deriving (Eq, Ord, Show, Read, Typeable, Data)+ -- | CPU vendors, supporting slightly different instruction sets. data Vendor   = Intel@@ -231,3 +269,82 @@ intel64 = Config Intel Mode64 SyntaxNone 0 amd32   = Config AMD   Mode32 SyntaxNone 0 amd64   = Config AMD   Mode64 SyntaxNone 0+++-- QuickCheck properties++_prop_Instruction_ReadShow :: Instruction -> Bool+_prop_Instruction_ReadShow i = read (show i) == i+++-- QuickCheck instances++arbEnum :: forall a. (Enum a, Bounded a) => Q.Gen a+arbEnum = toEnum <$> Q.choose (fromEnum lb, fromEnum ub) where+  lb, ub :: a+  (lb, ub) = (minBound, maxBound)++instance Q.Arbitrary GPR             where arbitrary = arbEnum+instance Q.Arbitrary Half            where arbitrary = arbEnum+instance Q.Arbitrary Segment         where arbitrary = arbEnum+instance Q.Arbitrary ControlRegister where arbitrary = arbEnum+instance Q.Arbitrary DebugRegister   where arbitrary = arbEnum+instance Q.Arbitrary MMXRegister     where arbitrary = arbEnum+instance Q.Arbitrary X87Register     where arbitrary = arbEnum+instance Q.Arbitrary XMMRegister     where arbitrary = arbEnum+instance Q.Arbitrary WordSize        where arbitrary = arbEnum+instance Q.Arbitrary Vendor          where arbitrary = arbEnum+instance Q.Arbitrary CPUMode         where arbitrary = arbEnum+instance Q.Arbitrary Syntax          where arbitrary = arbEnum+instance Q.Arbitrary Opcode          where arbitrary = arbEnum++instance Q.Arbitrary Register where+  arbitrary = Q.oneof [+      pure RegNone+    , pure RegIP+    , Reg8   <$> Q.arbitrary <*> Q.arbitrary+    , Reg16  <$> Q.arbitrary+    , Reg32  <$> Q.arbitrary+    , Reg64  <$> Q.arbitrary+    , RegSeg <$> Q.arbitrary+    , RegCtl <$> Q.arbitrary+    , RegDbg <$> Q.arbitrary+    , RegMMX <$> Q.arbitrary+    , RegX87 <$> Q.arbitrary+    , RegXMM <$> Q.arbitrary ]++instance (Q.Arbitrary t) => Q.Arbitrary (Immediate t) where+  arbitrary = Immediate <$> Q.arbitrary <*> Q.arbitrary++instance Q.Arbitrary Pointer where+  arbitrary = Pointer <$> Q.arbitrary <*> Q.arbitrary++instance Q.Arbitrary Memory where+  arbitrary = Memory <$> Q.arbitrary <*> Q.arbitrary <*> Q.arbitrary+                     <*> Q.arbitrary <*> Q.arbitrary++instance Q.Arbitrary Operand where+  arbitrary = Q.oneof [+      Mem   <$> Q.arbitrary+    , Reg   <$> Q.arbitrary+    , Ptr   <$> Q.arbitrary+    , Imm   <$> Q.arbitrary+    , Jump  <$> Q.arbitrary+    , Const <$> Q.arbitrary ]++instance Q.Arbitrary Prefix where+  arbitrary = Q.oneof (+    (Seg <$> Q.arbitrary)+    : map pure [Rex, OperSize, AddrSize, Lock, Rep, RepE, RepNE] )++instance Q.Arbitrary Instruction where+  arbitrary = do+    np <- Q.choose (0,3)+    no <- Q.choose (0,3)+    Inst <$> Q.vectorOf np Q.arbitrary+         <*> Q.arbitrary+         <*> Q.vectorOf no Q.arbitrary++instance Q.Arbitrary Config where+  arbitrary = Config <$> Q.arbitrary <*> Q.arbitrary+                     <*> Q.arbitrary <*> Q.arbitrary

@@ -1,5 +1,5 @@ name:                hdis86-version:             0.1+version:             0.2 license:             BSD3 license-file:        LICENSE synopsis:            Interface to the udis86 disassembler for x86 and x86-64 / AMD64@@ -8,7 +8,7 @@ maintainer:          Keegan McAllister <mcallister.keegan@gmail.com> homepage:            https://github.com/kmcallister/hdis86 build-type:          Simple-cabal-version:       >=1.2+cabal-version:       >=1.6 description:   @hdis86@ is an interface to the @udis86@ disassembler, which decodes machine   code for 16-, 32-, and 64-bit x86  and x86-64 / AMD64 processors.  @hdis86@@@ -30,7 +30,9 @@   .   Many users can simply import @Hdis86@.   .-+  The @Incremental@ module provides disassembly of lazy @ByteString@s, and a+  function for building other incremental operations.+  .   By default, @hdis86@ will statically link a built-in copy of @udis86-1.7@,   which is provided by its author under a similar BSD license.  See inside the   tarball for more information.  If you have @udis86@ installed on your system,@@ -40,10 +42,21 @@   This code is available on GitHub at <https://github.com/kmcallister/hdis86>.   .   The @udis86@ project website is located at <http://udis86.sourceforge.net/>.+  .+  New in version 0.2:+  .+    * Disassembly of lazy @ByteString@s+  .+    * A function for building other incremental operations+  .+    * Record selectors on @Instruction@+  .+    * QuickCheck @Arbitrary@ instances for @Instruction@ and related types  extra-source-files:     tools/hdcli.hs   , tools/gen_opcode.sh+  , tools/test_lazy_bytestring.hs   , udis86-1.7/libudis86/decode.h   , udis86-1.7/libudis86/input.h   , udis86-1.7/libudis86/syn.h@@ -65,15 +78,18 @@       Hdis86     , Hdis86.Types     , Hdis86.Pure+    , Hdis86.Incremental     , Hdis86.IO     , Hdis86.C-    , Hdis86.Internal.Opcode     , Hdis86.Internal.Map+  other-modules:+      Hdis86.Internal.Opcode   ghc-options:       -Wall   build-depends:       base       >= 3 && < 5     , containers >= 0.3     , bytestring >= 0.9+    , QuickCheck >= 2.4    if flag(external-udis86)     extra-libraries: udis86@@ -87,3 +103,16 @@       udis86-1.7/libudis86/syn.c       udis86-1.7/libudis86/syn-att.c       udis86-1.7/libudis86/syn-intel.c++  other-extensions:+      DeriveDataTypeable+    , RecordWildCards+    , NamedFieldPuns+    , ViewPatterns+    , ForeignFunctionInterface+    , EmptyDataDecls+    , ScopedTypeVariables++source-repository head+    type:     git+    location: git://github.com/kmcallister/hdis86.git

@@ -0,0 +1,69 @@+module Main(main) where++{- Check correctness and speed of lazy ByteString disassembly+   versus strict ByteString disassembly.++   $ for p in mwc-random clock groom; do cabal install $p; done+   $ ghc --make -O test_lazy_bytestring.hs+   $ ./test_lazy_bytestring+-}++import qualified Data.ByteString      as BS+import qualified Data.ByteString.Lazy as BL+import qualified Data.Vector.Unboxed  as V+import qualified System.Random.MWC    as R+import qualified System.Posix.Clock   as C++import Control.Monad+import Control.Exception ( evaluate )+import System.Exit+import System.IO+import Text.Groom+import Text.Printf++import Hdis86+import Hdis86.Incremental++splitBS :: R.GenIO -> BS.ByteString -> IO [BS.ByteString]+splitBS _   bs | BS.length bs < 2 = return [bs]+splitBS gen bs = do+    die <- R.uniformR (0,4) gen+    if die == (0 :: Int)+        then return [bs]+        else do+            i <- R.uniformR (1, BS.length bs - 1) gen+            let (x,y) = BS.splitAt i bs+            fmap (x:) (splitBS gen y)++time :: IO () -> IO Double+time x = do+    let get = C.getTime C.Monotonic+    C.TimeSpec s0 ns0 <- get+    x+    C.TimeSpec s1 ns1 <- get+    let scale = ((10 ** (-9)) *) . fromIntegral+    return (fromIntegral (s1 - s0) + scale (ns1 - ns0))++main :: IO ()+main = R.withSystemRandom $ \gen -> forever $ do+    size   <- R.uniformR (2^16, 2^21) gen+    vec    <- R.uniformVector gen size+    let bs =  BS.pack (V.toList vec)+    chunks <- splitBS gen bs+    let bl =  BL.fromChunks chunks+    _      <- evaluate (BS.length bs)+    _      <- evaluate (BL.length bl)++    let ms = disassembleMetadata amd64 bs+        ml = disassembleLazy     amd64 bl+        force = time . mapM_ (evaluate . inOpcode . mdInst)+    ts <- force $ disassembleMetadata amd64 bs+    tl <- force $ disassembleLazy     amd64 bl++    _  <- printf "%4d kB in %3d chunks: %5.2f s / %5.2f s = %6.2f%% speed\n"+        (size `div` 1024) (length chunks) ts tl (100 * ts / tl)+    when (ms /= ml) $ do+        hPutStr stderr "FAIL; check out.*\n"+        writeFile "out.strict" $ groom ms+        writeFile "out.lazy"   $ groom ml+        exitWith (ExitFailure 1)