Initial commit: 4.1.0.0

BeaEngine.cabal

@@ -0,0 +1,103 @@
+name:                BeaEngine
+version:             4.1.0.0
+synopsis:            binding: BeaEngine disassembler
+description:         
+  - Direct binding to the C API. 
+  - Symbol names mostly unchanged; prefixed to enforce haskell naming rules.
+  - BeaEngine library source (LGPL-3) included and statically linked.
+  - Package version numbering uses convention: C.C.H.H - where C is the underlying version of the C library, and H is the local Haskell binding revision.
+
+homepage:            http://www.beaengine.org/
+license:             LGPL-3
+license-file:        LICENSE
+author:              Neal Alexander
+maintainer:          [email protected]
+-- copyright:           
+category:            Disassembler
+build-type:          Simple
+-- extra-source-files:  
+cabal-version:       >=1.10
+
+
+extra-source-files: 
+  include/bindings.dsl.custom.h
+  include/beaengine/basic_types.h
+  include/beaengine/BeaEngine.h
+  include/beaengine/export.h
+  include/beaengine/macros.h
+  csrc/BeaEngine.c
+  csrc/CMakeLists.txt
+  csrc/COPYING.LESSER.txt
+  csrc/COPYING.txt
+  csrc/README.txt
+  csrc/Includes/BeaEngineVersion.c
+  csrc/Includes/internal_datas.h
+  csrc/Includes/protos.h
+  csrc/Includes/Routines_Disasm.c
+  csrc/Includes/Routines_ModRM.c
+  csrc/Includes/instr_set/Data_opcode.h
+  csrc/Includes/instr_set/opcodes_AES.c
+  csrc/Includes/instr_set/opcodes_A_M.c
+  csrc/Includes/instr_set/opcodes_CLMUL.c
+  csrc/Includes/instr_set/opcodes_FPU.c
+  csrc/Includes/instr_set/opcodes_Grp1.c
+  csrc/Includes/instr_set/opcodes_Grp12.c
+  csrc/Includes/instr_set/opcodes_Grp13.c
+  csrc/Includes/instr_set/opcodes_Grp14.c
+  csrc/Includes/instr_set/opcodes_Grp15.c
+  csrc/Includes/instr_set/opcodes_Grp16.c
+  csrc/Includes/instr_set/opcodes_Grp2.c
+  csrc/Includes/instr_set/opcodes_Grp3.c
+  csrc/Includes/instr_set/opcodes_Grp4.c
+  csrc/Includes/instr_set/opcodes_Grp5.c
+  csrc/Includes/instr_set/opcodes_Grp6.c
+  csrc/Includes/instr_set/opcodes_Grp7.c
+  csrc/Includes/instr_set/opcodes_Grp8.c
+  csrc/Includes/instr_set/opcodes_Grp9.c
+  csrc/Includes/instr_set/opcodes_MMX.c
+  csrc/Includes/instr_set/opcodes_N_Z.c
+  csrc/Includes/instr_set/opcodes_prefixes.c
+  csrc/Includes/instr_set/opcodes_SSE.c
+
+library
+  exposed-modules:    
+        BeaEngine,
+        BeaEngine.REX, 
+        BeaEngine.PrefixInfo, 
+        BeaEngine.MemoryType, 
+        BeaEngine.InstrType, 
+        BeaEngine.EFL, 
+        BeaEngine.Disasm,
+        BeaEngine.Constants,
+        BeaEngine.ArgType
+
+  c-sources: 
+        csrc/BeaEngine.c 
+
+  include-dirs: include/BeaEngine/
+  include-dirs: include/
+  hs-source-dirs: .
+  hs-source-dirs: BeaEngine
+  hs-source-dirs: test
+
+  CC-Options: "-DBEA_ENGINE_STATIC"
+
+  build-depends:       base >=4.7 && <4.8, bytestring >= 0.10.4.0     
+  build-tools:         hsc2hs
+  default-language:    Haskell2010
+
+Test-Suite test-marshal
+  type:                exitcode-stdio-1.0
+  main-is:             Test_Marshal.hs
+  build-depends:       base >= 4.7, BeaEngine == 4.1.0.0
+  default-language:    Haskell2010
+  hs-source-dirs:      test
+  c-sources:           test/Test_Marshal.c 
+
+Test-Suite test-disasm
+  type:                exitcode-stdio-1.0
+  main-is:             Test_Disasm.hs
+  build-depends:       base >= 4.7, bytestring >= 0.10.4.0, BeaEngine == 4.1.0.0
+  default-language:    Haskell2010
+  hs-source-dirs:      test
+

BeaEngine/ArgType.hsc

@@ -0,0 +1,34 @@
+{-# OPTIONS_GHC -fno-warn-unused-imports #-}
+#include <bindings.dsl.custom.h>
+#include <BeaEngine.h>
+module BeaEngine.ArgType where
+import Foreign.Ptr
+import Foreign.C.String
+import Data.Word
+import Data.Int
+import Data.List
+import BeaEngine.MemoryType
+#strict_import
+
+
+{- typedef struct {
+            char ArgMnemonic[64];
+            Int32 ArgType;
+            Int32 ArgSize;
+            Int32 ArgPosition;
+            UInt32 AccessMode;
+            MEMORYTYPE Memory;
+            UInt32 SegmentReg;
+        } ARGTYPE; -}
+
+#starttype ARGTYPE
+#array_field ArgMnemonic , CChar
+#field ArgType , Int32
+#field ArgSize , Int32
+#field ArgPosition , Int32
+#field AccessMode , Word32
+#field Memory , <MEMORYTYPE>
+#field SegmentReg , Word32
+#stoptype
+
+cArgMnemonicS = map castCCharToChar . takeWhile (/=0) . cArgMnemonic

BeaEngine/BeaEngine.hs

@@ -0,0 +1,69 @@
+module BeaEngine 
+    (MachineCode(..),dasm,
+     module BeaEngine.Disasm,
+     module BeaEngine.REX,
+     module BeaEngine.PrefixInfo,
+     module BeaEngine.MemoryType,
+     module BeaEngine.InstrType,
+     module BeaEngine.ArgType,
+     module BeaEngine.Constants
+    )
+where
+import Foreign.C.String
+import Foreign.C.Types
+import Foreign
+import BeaEngine.Disasm
+import BeaEngine.REX
+import BeaEngine.PrefixInfo hiding (palignment,calignment)
+import BeaEngine.MemoryType
+import BeaEngine.InstrType
+import BeaEngine.ArgType
+import BeaEngine.Constants
+import qualified Data.ByteString as B
+import qualified Data.ByteString.Internal as B
+import System.IO.Unsafe
+import Debug.Trace
+
+data MachineCode = X86_16 { mcd :: B.ByteString }
+                 | X86_32 { mcd :: B.ByteString }
+                 | X86_64 { mcd :: B.ByteString }
+
+
+mcid X86_32{} = 0
+mcid X86_16{} = 16
+mcid X86_64{} = 64
+
+
+
+dasm a b = unsafePerformIO (dasmIO a b)
+
+dasmIO :: Word32 -> MachineCode -> IO [C_Disasm]
+dasmIO options code' = do --allocaBytes (length code) $ \c -> 
+  let (b,bi,bn) = B.toForeignPtr (mcd code')
+  withForeignPtr b $ \c -> do
+           alloca $ \d -> do           
+             poke (pArchi d) (fromIntegral $ mcid code')
+             poke (pOptions d) 0
+
+             f bn d (fromIntegral $ ptrToIntPtr c) (fromIntegral bi)
+
+    where
+
+      f :: Int -> Ptr C_Disasm -> Word64 -> WordPtr -> IO [C_Disasm]
+      f codeN d vmbase offset
+          | limit > 0 = do
+                        poke (pEIP d) (fromIntegral vmbase + offset)
+                        poke (pVirtualAddr d) vmbase
+                        poke (pSecurityBlock d) limit
+
+                        n <- cDisasm d
+
+                        if (n <= 0)
+                           then error ("disasm: " ++ (show (n,limit,offset)))
+                           else do
+                             v <- peek d
+                             return . (v:) =<< (unsafeInterleaveIO $ f codeN d vmbase (offset + fromIntegral n))
+          where
+            limit = max 0 (fromIntegral $ codeN - (fromIntegral offset))
+
+      f _ _ _ _ = return []