harpy 0.4.1 → 0.4.2

raw patch · 6 files changed

+659/−3304 lines, 6 filesdep +disassemblerdep ~basePVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: disassembler

Dependency ranges changed: base

API changes (from Hackage documentation)

Files

• Harpy/CodeGenMonad.hs +15/−19
• Harpy/X86Assembler.hs +371/−18
• Harpy/X86CodeGen.hs +222/−29
• Harpy/X86Disassembler.hs +20/−3233
• NEWS +23/−0
• harpy.cabal +8/−5

@@ -452,11 +452,11 @@  performFixup :: Ptr Word8 -> Int -> FixupEntry -> CodeGen e s () performFixup labBuf labOfs (FixupEntry{fueBuffer = buf, fueOfs = ofs, fueKind = knd}) =-    do let diff = (labBuf `plusPtr` labOfs) `minusPtr` (buf `plusPtr` (ofs + 4))+    do let diff = (labBuf `plusPtr` labOfs) `minusPtr` (buf `plusPtr` ofs)        liftIO $ case knd of-                  Fixup8 -> pokeByteOff buf ofs (fromIntegral diff :: Word8)-                  Fixup16 -> pokeByteOff buf ofs (fromIntegral diff :: Word16)-                  Fixup32 -> pokeByteOff buf ofs (fromIntegral diff :: Word32)+                  Fixup8  -> pokeByteOff buf ofs (fromIntegral diff - 1 :: Word8)+                  Fixup16 -> pokeByteOff buf ofs (fromIntegral diff - 2 :: Word16)+                  Fixup32 -> pokeByteOff buf ofs (fromIntegral diff - 4 :: Word32)                   Fixup32Absolute -> pokeByteOff buf ofs (fromIntegral (ptrToWordPtr (labBuf `plusPtr` labOfs)) :: Word32)        return () @@ -480,14 +480,12 @@     do state <- getInternalState         let base = buffer state            ptr = bufferOfs state+           fue = FixupEntry{fueBuffer = base,+                            fueOfs = ptr + ofs,+                            fueKind = knd}        case Map.lookup lab (definedLabels state) of-         Just (labBuf, labOfs, _) -> performFixup labBuf labOfs (FixupEntry{fueBuffer = base,-                                                                            fueOfs = ptr + ofs,-                                                                            fueKind = knd})-         Nothing -> setInternalState state{pendingFixups = Map.insertWith (++) lab [FixupEntry{fueBuffer = base,-                                                                                          fueOfs = ptr + ofs,-                                                                                          fueKind = knd}]-                                                                                          (pendingFixups state)}+         Just (labBuf, labOfs, _) -> performFixup labBuf labOfs fue+         Nothing -> setInternalState state{pendingFixups = Map.insertWith (++) lab [fue] (pendingFixups state)}  -- | Return the address of a label, fail if the label is not yet defined. labelAddress :: Label -> CodeGen e s (Ptr a)@@ -521,12 +519,10 @@        ins i@(Dis.PseudoInstruction{}) = return [i]        ins i@(Dis.Instruction{Dis.address = addr}) =            do state <- getInternalState-              let labs = Map.toList (definedLabels state)-                  lab = find (\ (_, (buf, ofs, _)) -> fromIntegral (ptrToWordPtr (buf `plusPtr` ofs)) == addr) labs-              case lab of-                Nothing -> return [i]-                Just (l, (buf, ofs, name)) -> return [Dis.PseudoInstruction addr-                                                         (case name of+              let allLabs = Map.toList (definedLabels state)+                  labs = filter (\ (_, (buf, ofs, _)) -> fromIntegral (ptrToWordPtr (buf `plusPtr` ofs)) == addr) allLabs+                  createLabel (l, (buf, ofs, name)) = Dis.PseudoInstruction addr+                                                        (case name of                                                            "" ->                                                                "label " ++ show l ++                                                                  " [" ++ @@ -534,8 +530,8 @@                                                                 "]"                                                            _ -> name ++ ": [" ++                                                                    hex32 (fromIntegral (ptrToWordPtr (buf `plusPtr` ofs))) ++ -                                                                  "]"), -                                                            i]+                                                                  "]")+              return $ fmap createLabel labs ++ [i]        hex32 :: Int -> String        hex32 i =               let w :: Word32

@@ -1,4 +1,4 @@-{-# LANGUAGE MultiParamTypeClasses,FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses,FlexibleInstances,FunctionalDependencies #-} -------------------------------------------------------------------------- -- | -- Module      :  Harpy.X86Assembler@@ -13,7 +13,10 @@ -- which determines the addressing modes from the types of the -- operands. ---------------------------------------------------------------------------module Harpy.X86Assembler where+module Harpy.X86Assembler (+   module Harpy.X86Assembler,+   XMMReg(..),+   ) where  import Harpy.X86CodeGen import Harpy.CodeGenMonad@@ -77,8 +80,10 @@ esi = Reg32 6 edi = Reg32 7 +{- newtype XMMReg = XMMReg Word8     deriving (Eq, Ord)+-}  xmm0, xmm1, xmm2, xmm3, xmm4, xmm5, xmm6, xmm7 :: XMMReg xmm0 = XMMReg 0@@ -654,6 +659,9 @@ instance Cmp Reg32 Word32 where   cmp (Reg32 dest) imm = ensureBufferSize x86_max_instruction_bytes >> x86_alu_reg_imm x86_cmp dest (fromIntegral imm) +instance Cmp Reg32 (Ptr a) where+  cmp (Reg32 dest) ptr = ensureBufferSize x86_max_instruction_bytes >> x86_alu_reg_imm x86_cmp dest (ptrToInt ptr)+ instance Cmp Reg32 Label where   cmp (Reg32 dest) lab = do       ensureBufferSize x86_max_instruction_bytes@@ -663,6 +671,9 @@ instance Cmp Addr Word32 where   cmp (Addr dest) imm = ensureBufferSize x86_max_instruction_bytes >> x86_alu_mem_imm x86_cmp dest (fromIntegral imm) +instance Cmp Addr (Ptr a) where+  cmp (Addr dest) ptr = ensureBufferSize x86_max_instruction_bytes >> x86_alu_mem_imm x86_cmp dest (ptrToWord32 ptr)+ instance Cmp Addr Label where   cmp (Addr dest) lab = do       ensureBufferSize x86_max_instruction_bytes >> x86_alu_mem_imm x86_cmp dest 0xf0f0f0f0@@ -671,6 +682,9 @@ instance Cmp (Disp, Reg32) Word32 where   cmp (Disp disp, Reg32 dest) imm = ensureBufferSize x86_max_instruction_bytes >> x86_alu_membase_imm x86_cmp dest disp (fromIntegral imm) +instance Cmp (Disp, Reg32) (Ptr a) where+  cmp (Disp disp, Reg32 dest) ptr = ensureBufferSize x86_max_instruction_bytes >> x86_alu_membase_imm x86_cmp dest disp (ptrToWord32 ptr)+ instance Cmp (Disp, Reg32) Label where   cmp (Disp disp, Reg32 dest) lab = do                                    ensureBufferSize x86_max_instruction_bytes >> x86_alu_membase_imm x86_cmp dest disp 0xf0f0f0f0@@ -679,6 +693,9 @@ instance Cmp Ind Word32 where   cmp (Ind (Reg32 dest)) imm = ensureBufferSize x86_max_instruction_bytes >> x86_alu_membase_imm x86_cmp dest 0 (fromIntegral imm) +instance Cmp Ind (Ptr a) where+  cmp (Ind (Reg32 dest)) ptr = ensureBufferSize x86_max_instruction_bytes >> x86_alu_membase_imm x86_cmp dest 0 (ptrToWord32 ptr)+ instance Cmp Ind Label where   cmp (Ind (Reg32 dest)) lab = do                          ensureBufferSize x86_max_instruction_bytes >> x86_alu_membase_imm x86_cmp dest 0 0xf0f0f0f0@@ -1127,6 +1144,9 @@ instance Mov Reg32 Word32 where   mov (Reg32 dest) imm = ensureBufferSize x86_max_instruction_bytes >> x86_mov_reg_imm dest (fromIntegral imm) +instance Mov Reg32 (Ptr a) where+  mov (Reg32 dest) ptr = ensureBufferSize x86_max_instruction_bytes >> x86_mov_reg_imm dest (ptrToWord32 ptr)+ instance Mov Reg32 Label where   mov (Reg32 dest) lab = do ensureBufferSize x86_max_instruction_bytes >> x86_mov_reg_imm dest 0                             emitFixup lab (-4) Fixup32Absolute@@ -1140,6 +1160,9 @@ instance Mov Addr Word32 where   mov (Addr dest) imm = ensureBufferSize x86_max_instruction_bytes >> x86_mov_mem_imm dest imm 4 +instance Mov Addr (Ptr a) where+  mov (Addr dest) ptr = ensureBufferSize x86_max_instruction_bytes >> x86_mov_mem_imm dest (ptrToWord32 ptr) 4+ instance Mov Addr Label where   mov (Addr dest) lab = do ensureBufferSize x86_max_instruction_bytes >> x86_mov_mem_imm dest 0 4                            emitFixup lab (-4) Fixup32Absolute@@ -1159,6 +1182,9 @@ instance Mov (Disp, Reg32) Word32 where   mov (Disp disp, Reg32 dest) imm = ensureBufferSize x86_max_instruction_bytes >> x86_mov_membase_imm dest disp imm 4 +instance Mov (Disp, Reg32) (Ptr a) where+  mov (Disp disp, Reg32 dest) ptr = ensureBufferSize x86_max_instruction_bytes >> x86_mov_membase_imm dest disp (ptrToWord32 ptr) 4+ instance Mov (Disp, Reg32) Label where   mov (Disp disp, Reg32 dest) lab = do ensureBufferSize x86_max_instruction_bytes >> x86_mov_membase_imm dest disp 0 4                                        emitFixup lab (-4) Fixup32Absolute@@ -1166,6 +1192,9 @@ instance Mov Ind Word32 where   mov (Ind (Reg32 dest)) imm = ensureBufferSize x86_max_instruction_bytes >> x86_mov_membase_imm dest 0 imm 4 +instance Mov Ind (Ptr a) where+  mov (Ind (Reg32 dest)) ptr = ensureBufferSize x86_max_instruction_bytes >> x86_mov_membase_imm dest 0 (ptrToWord32 ptr) 4+ instance Mov Ind Label where   mov (Ind (Reg32 dest)) lab = do ensureBufferSize x86_max_instruction_bytes >> x86_mov_membase_imm dest 0 0 4                                   emitFixup lab (-4) Fixup32Absolute@@ -1179,6 +1208,9 @@ instance Mov (Reg32, Reg32, Scale) Word32 where   mov (Reg32 base, Reg32 index, scale) imm = ensureBufferSize x86_max_instruction_bytes >> x86_mov_memindex_imm base 0 index (scaleToShift scale) imm 4 +instance Mov (Reg32, Reg32, Scale) (Ptr a) where+  mov (Reg32 base, Reg32 index, scale) ptr = ensureBufferSize x86_max_instruction_bytes >> x86_mov_memindex_imm base 0 index (scaleToShift scale) (ptrToWord32 ptr) 4+ instance Mov (Reg32, Reg32, Scale) Label where   mov (Reg32 base, Reg32 index, scale) lab = do ensureBufferSize x86_max_instruction_bytes >> x86_mov_memindex_imm base 0 index (scaleToShift scale) 0 4                                                 emitFixup lab (-4) Fixup32Absolute@@ -1192,6 +1224,9 @@ instance Mov (Disp, Reg32, Scale) Word32 where   mov (Disp disp, Reg32 index, scale) imm = ensureBufferSize x86_max_instruction_bytes >> x86_mov_memindex_imm x86_nobasereg disp index (scaleToShift scale) imm 4 +instance Mov (Disp, Reg32, Scale) (Ptr a) where+  mov (Disp disp, Reg32 index, scale) ptr = ensureBufferSize x86_max_instruction_bytes >> x86_mov_memindex_imm x86_nobasereg disp index (scaleToShift scale) (ptrToWord32 ptr) 4+ instance Mov (Disp, Reg32, Scale) Label where   mov (Disp disp, Reg32 index, scale) lab = do ensureBufferSize x86_max_instruction_bytes >> x86_mov_memindex_imm x86_nobasereg disp index (scaleToShift scale) 0 4                                                emitFixup lab (-4) Fixup32Absolute@@ -1208,6 +1243,10 @@   mov (Disp disp, Reg32 5, Reg32 index, scale) imm = ensureBufferSize x86_max_instruction_bytes >> x86_mov_memindex_imm 5 disp index (scaleToShift scale) imm 4   mov _ _ = onlyEbp +instance Mov (Disp, Reg32, Reg32, Scale) (Ptr a) where+  mov (Disp disp, Reg32 5, Reg32 index, scale) ptr = ensureBufferSize x86_max_instruction_bytes >> x86_mov_memindex_imm 5 disp index (scaleToShift scale) (ptrToWord32 ptr) 4+  mov _ _ = onlyEbp+ instance Mov (Disp, Reg32, Reg32, Scale) Label where   mov (Disp disp, Reg32 5, Reg32 index, scale) lab = do ensureBufferSize x86_max_instruction_bytes >> x86_mov_memindex_imm 5 disp index (scaleToShift scale) 0 4                                                         emitFixup lab (-4) Fixup32Absolute@@ -1539,17 +1578,25 @@ popfd  = ensureBufferSize x86_max_instruction_bytes >> x86_popfd  --- loop according to ECX couter--loop   :: Word8 -> CodeGen e s ()-loop w   = ensureBufferSize x86_max_instruction_bytes >> x86_loop w+-- loop according to ECX counter -loope  :: Word8 -> CodeGen e s ()-loope w  = ensureBufferSize x86_max_instruction_bytes >> x86_loope w+class Loop a where+  loop   :: a -> CodeGen e s ()+  loope  :: a -> CodeGen e s ()+  loopne :: a -> CodeGen e s () -loopne :: Word8 -> CodeGen e s ()-loopne w = ensureBufferSize x86_max_instruction_bytes >> x86_loopne w+instance Loop Word8 where+    loop w   = ensureBufferSize x86_max_instruction_bytes >> x86_loop w+    loope w  = ensureBufferSize x86_max_instruction_bytes >> x86_loope w+    loopne w = ensureBufferSize x86_max_instruction_bytes >> x86_loopne w +instance Loop Label where+    loop l   = do ensureBufferSize x86_max_instruction_bytes >> x86_loop 0+                  emitFixup l (-1) Fixup8+    loope l  = do ensureBufferSize x86_max_instruction_bytes >> x86_loope 0+                  emitFixup l (-1) Fixup8+    loopne l = do ensureBufferSize x86_max_instruction_bytes >> x86_loopne 0+                  emitFixup l (-1) Fixup8  -- jump @@ -1592,6 +1639,9 @@ instance Ja Word32 where   ja imm = ensureBufferSize x86_max_instruction_bytes >> x86_branch32 x86_cc_a imm False +instance Ja (Ptr a) where+  ja ptr = ensureBufferSize x86_max_instruction_bytes >> x86_branch_pointer x86_cc_a ptr False+ instance Ja Label where   ja l = do ensureBufferSize x86_max_instruction_bytes >> x86_branch32 x86_cc_a 0 False             emitFixup l (-4) Fixup32@@ -1605,6 +1655,9 @@ instance Jae Word32 where   jae imm = ensureBufferSize x86_max_instruction_bytes >> x86_branch32 x86_cc_ae imm False +instance Jae (Ptr a) where+  jae ptr = ensureBufferSize x86_max_instruction_bytes >> x86_branch_pointer x86_cc_ae ptr False+ instance Jae Label where   jae l = do ensureBufferSize x86_max_instruction_bytes >> x86_branch32 x86_cc_ae 0 False              emitFixup l (-4) Fixup32@@ -1618,6 +1671,9 @@ instance Jb Word32 where   jb imm = ensureBufferSize x86_max_instruction_bytes >> x86_branch32 x86_cc_b imm False +instance Jb (Ptr a) where+  jb ptr = ensureBufferSize x86_max_instruction_bytes >> x86_branch_pointer x86_cc_b ptr False+ instance Jb Label where   jb l = do ensureBufferSize x86_max_instruction_bytes >> x86_branch32 x86_cc_b 0 False             emitFixup l (-4) Fixup32@@ -1631,6 +1687,9 @@ instance Jbe Word32 where   jbe imm = ensureBufferSize x86_max_instruction_bytes >> x86_branch32 x86_cc_be imm False +instance Jbe (Ptr a) where+  jbe ptr = ensureBufferSize x86_max_instruction_bytes >> x86_branch_pointer x86_cc_be ptr False+ instance Jbe Label where   jbe l = do ensureBufferSize x86_max_instruction_bytes >> x86_branch32 x86_cc_be 0 False              emitFixup l (-4) Fixup32@@ -1644,6 +1703,9 @@ instance Jc Word32 where   jc imm = ensureBufferSize x86_max_instruction_bytes >> x86_branch32 x86_cc_c imm False +instance Jc (Ptr a) where+  jc ptr = ensureBufferSize x86_max_instruction_bytes >> x86_branch_pointer x86_cc_c ptr False+ instance Jc Label where   jc l = do ensureBufferSize x86_max_instruction_bytes >> x86_branch32 x86_cc_c 0 False             emitFixup l (-4) Fixup32@@ -1657,6 +1719,9 @@ instance Je Word32 where   je imm = ensureBufferSize x86_max_instruction_bytes >> x86_branch32 x86_cc_e imm False +instance Je (Ptr a) where+  je ptr = ensureBufferSize x86_max_instruction_bytes >> x86_branch_pointer x86_cc_e ptr False+ instance Je Label where   je l = do ensureBufferSize x86_max_instruction_bytes >> x86_branch32 x86_cc_e 0 False             emitFixup l (-4) Fixup32@@ -1670,6 +1735,9 @@ instance Jna Word32 where   jna imm = ensureBufferSize x86_max_instruction_bytes >> x86_branch32 x86_cc_na imm False +instance Jna (Ptr a) where+  jna ptr = ensureBufferSize x86_max_instruction_bytes >> x86_branch_pointer x86_cc_na ptr False+ instance Jna Label where   jna l = do ensureBufferSize x86_max_instruction_bytes >> x86_branch32 x86_cc_na 0 False              emitFixup l (-4) Fixup32@@ -1683,6 +1751,9 @@ instance Jnae Word32 where   jnae imm = ensureBufferSize x86_max_instruction_bytes >> x86_branch32 x86_cc_nae imm False +instance Jnae (Ptr a) where+  jnae ptr = ensureBufferSize x86_max_instruction_bytes >> x86_branch_pointer x86_cc_nae ptr False+ instance Jnae Label where   jnae l = do ensureBufferSize x86_max_instruction_bytes >> x86_branch32 x86_cc_nae 0 False               emitFixup l (-4) Fixup32@@ -1696,6 +1767,9 @@ instance Jnb Word32 where   jnb imm = ensureBufferSize x86_max_instruction_bytes >> x86_branch32 x86_cc_nb imm False +instance Jnb (Ptr a) where+  jnb ptr = ensureBufferSize x86_max_instruction_bytes >> x86_branch_pointer x86_cc_nb ptr False+ instance Jnb Label where   jnb l = do ensureBufferSize x86_max_instruction_bytes >> x86_branch32 x86_cc_nb 0 False              emitFixup l (-4) Fixup32@@ -1709,6 +1783,9 @@ instance Jnbe Word32 where   jnbe imm = ensureBufferSize x86_max_instruction_bytes >> x86_branch32 x86_cc_nbe imm False +instance Jnbe (Ptr a) where+  jnbe ptr = ensureBufferSize x86_max_instruction_bytes >> x86_branch_pointer x86_cc_nbe ptr False+ instance Jnbe Label where   jnbe l = do ensureBufferSize x86_max_instruction_bytes >> x86_branch32 x86_cc_nbe 0 False               emitFixup l (-4) Fixup32@@ -1722,6 +1799,9 @@ instance Jnc Word32 where   jnc imm = ensureBufferSize x86_max_instruction_bytes >> x86_branch32 x86_cc_nc imm False +instance Jnc (Ptr a) where+  jnc ptr = ensureBufferSize x86_max_instruction_bytes >> x86_branch_pointer x86_cc_nc ptr False+ instance Jnc Label where   jnc l = do ensureBufferSize x86_max_instruction_bytes >> x86_branch32 x86_cc_nc 0 False              emitFixup l (-4) Fixup32@@ -1735,6 +1815,9 @@ instance Jne Word32 where   jne imm = ensureBufferSize x86_max_instruction_bytes >> x86_branch32 x86_cc_ne imm False +instance Jne (Ptr a) where+  jne ptr = ensureBufferSize x86_max_instruction_bytes >> x86_branch_pointer x86_cc_ne ptr False+ instance Jne Label where   jne l = do ensureBufferSize x86_max_instruction_bytes >> x86_branch32 x86_cc_ne 0 False              emitFixup l (-4) Fixup32@@ -1748,6 +1831,9 @@ instance Jnp Word32 where   jnp imm = ensureBufferSize x86_max_instruction_bytes >> x86_branch32 x86_cc_np imm False +instance Jnp (Ptr a) where+  jnp ptr = ensureBufferSize x86_max_instruction_bytes >> x86_branch_pointer x86_cc_np ptr False+ instance Jnp Label where   jnp l = do ensureBufferSize x86_max_instruction_bytes >> x86_branch32 x86_cc_np 0 False              emitFixup l (-4) Fixup32@@ -1761,6 +1847,9 @@ instance Jnz Word32 where   jnz imm = ensureBufferSize x86_max_instruction_bytes >> x86_branch32 x86_cc_nz imm False +instance Jnz (Ptr a) where+  jnz ptr = ensureBufferSize x86_max_instruction_bytes >> x86_branch_pointer x86_cc_nz ptr False+ instance Jnz Label where   jnz l = do ensureBufferSize x86_max_instruction_bytes >> x86_branch32 x86_cc_nz 0 False              emitFixup l (-4) Fixup32@@ -1774,6 +1863,9 @@ instance Jp Word32 where   jp imm = ensureBufferSize x86_max_instruction_bytes >> x86_branch32 x86_cc_p imm False +instance Jp (Ptr a) where+  jp ptr = ensureBufferSize x86_max_instruction_bytes >> x86_branch_pointer x86_cc_p ptr False+ instance Jp Label where   jp l = do ensureBufferSize x86_max_instruction_bytes >> x86_branch32 x86_cc_p 0 False             emitFixup l (-4) Fixup32@@ -1787,6 +1879,9 @@ instance Jpe Word32 where   jpe imm = ensureBufferSize x86_max_instruction_bytes >> x86_branch32 x86_cc_pe imm False +instance Jpe (Ptr a) where+  jpe ptr = ensureBufferSize x86_max_instruction_bytes >> x86_branch_pointer x86_cc_pe ptr False+ instance Jpe Label where   jpe l = do ensureBufferSize x86_max_instruction_bytes >> x86_branch32 x86_cc_pe 0 False              emitFixup l (-4) Fixup32@@ -1800,6 +1895,9 @@ instance Jpo Word32 where   jpo imm = ensureBufferSize x86_max_instruction_bytes >> x86_branch32 x86_cc_po imm False +instance Jpo (Ptr a) where+  jpo ptr = ensureBufferSize x86_max_instruction_bytes >> x86_branch_pointer x86_cc_po ptr False+ instance Jpo Label where   jpo l = do ensureBufferSize x86_max_instruction_bytes >> x86_branch32 x86_cc_po 0 False              emitFixup l (-4) Fixup32@@ -1813,6 +1911,9 @@ instance Jz Word32 where   jz imm = ensureBufferSize x86_max_instruction_bytes >> x86_branch32 x86_cc_z imm False +instance Jz (Ptr a) where+  jz ptr = ensureBufferSize x86_max_instruction_bytes >> x86_branch_pointer x86_cc_z ptr False+ instance Jz Label where   jz l = do ensureBufferSize x86_max_instruction_bytes >> x86_branch32 x86_cc_z 0 False             emitFixup l (-4) Fixup32@@ -1826,6 +1927,9 @@ instance Jg Word32 where   jg imm = ensureBufferSize x86_max_instruction_bytes >> x86_branch32 x86_cc_gt imm True +instance Jg (Ptr a) where+  jg ptr = ensureBufferSize x86_max_instruction_bytes >> x86_branch_pointer x86_cc_gt ptr True+ instance Jg Label where   jg l = do ensureBufferSize x86_max_instruction_bytes >> x86_branch32 x86_cc_gt 0 True             emitFixup l (-4) Fixup32@@ -1839,6 +1943,9 @@ instance Jge Word32 where   jge imm = ensureBufferSize x86_max_instruction_bytes >> x86_branch32 x86_cc_ge imm True +instance Jge (Ptr a) where+  jge ptr = ensureBufferSize x86_max_instruction_bytes >> x86_branch_pointer x86_cc_ge ptr True+ instance Jge Label where   jge l = do ensureBufferSize x86_max_instruction_bytes >> x86_branch32 x86_cc_ge 0 True              emitFixup l (-4) Fixup32@@ -1852,6 +1959,9 @@ instance Jl Word32 where   jl imm = ensureBufferSize x86_max_instruction_bytes >> x86_branch32 x86_cc_lt imm True +instance Jl (Ptr a) where+  jl ptr = ensureBufferSize x86_max_instruction_bytes >> x86_branch_pointer x86_cc_lt ptr True+ instance Jl Label where   jl l = do ensureBufferSize x86_max_instruction_bytes >> x86_branch32 x86_cc_lt 0 True             emitFixup l (-4) Fixup32@@ -1865,6 +1975,9 @@ instance Jle Word32 where   jle imm = ensureBufferSize x86_max_instruction_bytes >> x86_branch32 x86_cc_le imm True +instance Jle (Ptr a) where+  jle ptr = ensureBufferSize x86_max_instruction_bytes >> x86_branch_pointer x86_cc_le ptr True+ instance Jle Label where   jle l = do ensureBufferSize x86_max_instruction_bytes >> x86_branch32 x86_cc_le 0 True              emitFixup l (-4) Fixup32@@ -1878,6 +1991,9 @@ instance Jng Word32 where   jng imm = ensureBufferSize x86_max_instruction_bytes >> x86_branch32 x86_cc_le imm True +instance Jng (Ptr a) where+  jng ptr = ensureBufferSize x86_max_instruction_bytes >> x86_branch_pointer x86_cc_le ptr True+ instance Jng Label where   jng l = do ensureBufferSize x86_max_instruction_bytes >> x86_branch32 x86_cc_le 0 True              emitFixup l (-4) Fixup32@@ -1891,6 +2007,9 @@ instance Jnge Word32 where   jnge imm = ensureBufferSize x86_max_instruction_bytes >> x86_branch32 x86_cc_lt imm True +instance Jnge (Ptr a) where+  jnge ptr = ensureBufferSize x86_max_instruction_bytes >> x86_branch_pointer x86_cc_lt ptr True+ instance Jnge Label where   jnge l = do ensureBufferSize x86_max_instruction_bytes >> x86_branch32 x86_cc_lt 0 True               emitFixup l (-4) Fixup32@@ -1904,6 +2023,9 @@ instance Jnl Word32 where   jnl imm = ensureBufferSize x86_max_instruction_bytes >> x86_branch32 x86_cc_ge imm True +instance Jnl (Ptr a) where+  jnl ptr = ensureBufferSize x86_max_instruction_bytes >> x86_branch_pointer x86_cc_ge ptr True+ instance Jnl Label where   jnl l = do ensureBufferSize x86_max_instruction_bytes >> x86_branch32 x86_cc_ge 0 True              emitFixup l (-4) Fixup32@@ -1917,6 +2039,9 @@ instance Jnle Word32 where   jnle imm = ensureBufferSize x86_max_instruction_bytes >> x86_branch32 x86_cc_gt imm True +instance Jnle (Ptr a) where+  jnle ptr = ensureBufferSize x86_max_instruction_bytes >> x86_branch_pointer x86_cc_gt ptr True+ instance Jnle Label where   jnle l = do ensureBufferSize x86_max_instruction_bytes >> x86_branch32 x86_cc_gt 0 True               emitFixup l (-4) Fixup32@@ -1930,6 +2055,9 @@ instance Jno Word32 where   jno imm = ensureBufferSize x86_max_instruction_bytes >> x86_branch32 x86_cc_no imm True +instance Jno (Ptr a) where+  jno ptr = ensureBufferSize x86_max_instruction_bytes >> x86_branch_pointer x86_cc_no ptr True+ instance Jno Label where   jno l = do ensureBufferSize x86_max_instruction_bytes >> x86_branch32 x86_cc_no 0 True              emitFixup l (-4) Fixup32@@ -1943,6 +2071,9 @@ instance Jns Word32 where   jns imm = ensureBufferSize x86_max_instruction_bytes >> x86_branch32 x86_cc_ns imm True +instance Jns (Ptr a) where+  jns ptr = ensureBufferSize x86_max_instruction_bytes >> x86_branch_pointer x86_cc_ns ptr True+ instance Jns Label where   jns l = do ensureBufferSize x86_max_instruction_bytes >> x86_branch32 x86_cc_ns 0 True              emitFixup l (-4) Fixup32@@ -1956,6 +2087,9 @@ instance Jo Word32 where   jo imm = ensureBufferSize x86_max_instruction_bytes >> x86_branch32 x86_cc_o imm True +instance Jo (Ptr a) where+  jo ptr = ensureBufferSize x86_max_instruction_bytes >> x86_branch_pointer x86_cc_o ptr True+ instance Jo Label where   jo l = do ensureBufferSize x86_max_instruction_bytes >> x86_branch32 x86_cc_o 0 True             emitFixup l (-4) Fixup32@@ -1969,6 +2103,9 @@ instance Js Word32 where   js imm = ensureBufferSize x86_max_instruction_bytes >> x86_branch32 x86_cc_s imm True +instance Js (Ptr a) where+  js ptr = ensureBufferSize x86_max_instruction_bytes >> x86_branch_pointer x86_cc_s ptr True+ instance Js Label where   js l = do ensureBufferSize x86_max_instruction_bytes >> x86_branch32 x86_cc_s 0 True             emitFixup l (-4) Fixup32@@ -2988,7 +3125,30 @@ instance Fadd FPTopReg Ind where     fadd FPTopReg (Ind (Reg32 r)) = ensureBufferSize x86_max_instruction_bytes >> x86_fp_op_membase x86_fadd r 0 True +instance Fadd FPReg FPTopReg where+    fadd (FPReg idx) FPTopReg = ensureBufferSize x86_max_instruction_bytes >> x86_fp_op_reg x86_fadd idx False ++class Faddp a b where+    faddp :: a -> b -> CodeGen e s ()++instance Faddp FPReg FPTopReg where+    faddp (FPReg idx) FPTopReg = ensureBufferSize x86_max_instruction_bytes >> x86_fp_op_reg x86_fadd idx True+++class Fiadd a b where+    fiadd32 :: a -> b -> CodeGen e s ()+    fiadd16 :: a -> b -> CodeGen e s ()++instance Fiadd FPTopReg (Disp, Reg32) where+    fiadd32 FPTopReg (Disp d, Reg32 r) = ensureBufferSize x86_max_instruction_bytes >> x86_fp_int_op_membase x86_fadd r d True+    fiadd16 FPTopReg (Disp d, Reg32 r) = ensureBufferSize x86_max_instruction_bytes >> x86_fp_int_op_membase x86_fadd r d False++instance Fiadd FPTopReg Ind where+    fiadd32 FPTopReg (Ind (Reg32 r)) = ensureBufferSize x86_max_instruction_bytes >> x86_fp_int_op_membase x86_fadd r 0 True+    fiadd16 FPTopReg (Ind (Reg32 r)) = ensureBufferSize x86_max_instruction_bytes >> x86_fp_int_op_membase x86_fadd r 0 False++ class Fsub a b where     fsub :: a -> b -> CodeGen e s () @@ -3004,7 +3164,30 @@ instance Fsub FPTopReg Ind where     fsub FPTopReg (Ind (Reg32 r)) = ensureBufferSize x86_max_instruction_bytes >> x86_fp_op_membase x86_fsub r 0 True +instance Fsub FPReg FPTopReg where+    fsub (FPReg idx) FPTopReg = ensureBufferSize x86_max_instruction_bytes >> x86_fp_op_reg x86_fsub idx False ++class Fsubp a b where+    fsubp :: a -> b -> CodeGen e s ()++instance Fsubp FPReg FPTopReg where+    fsubp (FPReg idx) FPTopReg = ensureBufferSize x86_max_instruction_bytes >> x86_fp_op_reg x86_fsub idx True+++class Fisub a b where+    fisub32 :: a -> b -> CodeGen e s ()+    fisub16 :: a -> b -> CodeGen e s ()++instance Fisub FPTopReg (Disp, Reg32) where+    fisub32 FPTopReg (Disp d, Reg32 r) = ensureBufferSize x86_max_instruction_bytes >> x86_fp_int_op_membase x86_fsub r d True+    fisub16 FPTopReg (Disp d, Reg32 r) = ensureBufferSize x86_max_instruction_bytes >> x86_fp_int_op_membase x86_fsub r d False++instance Fisub FPTopReg Ind where+    fisub32 FPTopReg (Ind (Reg32 r)) = ensureBufferSize x86_max_instruction_bytes >> x86_fp_int_op_membase x86_fsub r 0 True+    fisub16 FPTopReg (Ind (Reg32 r)) = ensureBufferSize x86_max_instruction_bytes >> x86_fp_int_op_membase x86_fsub r 0 False++ class Fsubr a b where     fsubr :: a -> b -> CodeGen e s () @@ -3036,7 +3219,30 @@ instance Fmul FPTopReg Ind where     fmul FPTopReg (Ind (Reg32 r)) = ensureBufferSize x86_max_instruction_bytes >> x86_fp_op_membase x86_fmul r 0 True +instance Fmul FPReg FPTopReg where+    fmul (FPReg idx) FPTopReg = ensureBufferSize x86_max_instruction_bytes >> x86_fp_op_reg x86_fmul idx False ++class Fmulp a b where+    fmulp :: a -> b -> CodeGen e s ()++instance Fmulp FPReg FPTopReg where+    fmulp (FPReg idx) FPTopReg = ensureBufferSize x86_max_instruction_bytes >> x86_fp_op_reg x86_fmul idx True+++class Fimul a b where+    fimul32 :: a -> b -> CodeGen e s ()+    fimul16 :: a -> b -> CodeGen e s ()++instance Fimul FPTopReg (Disp, Reg32) where+    fimul32 FPTopReg (Disp d, Reg32 r) = ensureBufferSize x86_max_instruction_bytes >> x86_fp_int_op_membase x86_fmul r d True+    fimul16 FPTopReg (Disp d, Reg32 r) = ensureBufferSize x86_max_instruction_bytes >> x86_fp_int_op_membase x86_fmul r d False++instance Fimul FPTopReg Ind where+    fimul32 FPTopReg (Ind (Reg32 r)) = ensureBufferSize x86_max_instruction_bytes >> x86_fp_int_op_membase x86_fmul r 0 True+    fimul16 FPTopReg (Ind (Reg32 r)) = ensureBufferSize x86_max_instruction_bytes >> x86_fp_int_op_membase x86_fmul r 0 False++ class Fdiv a b where     fdiv :: a -> b -> CodeGen e s () @@ -3052,7 +3258,30 @@ instance Fdiv FPTopReg Ind where     fdiv FPTopReg (Ind (Reg32 r)) = ensureBufferSize x86_max_instruction_bytes >> x86_fp_op_membase x86_fdiv r 0 True +instance Fdiv FPReg FPTopReg where+    fdiv (FPReg idx) FPTopReg = ensureBufferSize x86_max_instruction_bytes >> x86_fp_op_reg x86_fdiv idx False ++class Fdivp a b where+    fdivp :: a -> b -> CodeGen e s ()++instance Fdivp FPReg FPTopReg where+    fdivp (FPReg idx) FPTopReg = ensureBufferSize x86_max_instruction_bytes >> x86_fp_op_reg x86_fdiv idx True+++class Fidiv a b where+    fidiv32 :: a -> b -> CodeGen e s ()+    fidiv16 :: a -> b -> CodeGen e s ()++instance Fidiv FPTopReg (Disp, Reg32) where+    fidiv32 FPTopReg (Disp d, Reg32 r) = ensureBufferSize x86_max_instruction_bytes >> x86_fp_int_op_membase x86_fdiv r d True+    fidiv16 FPTopReg (Disp d, Reg32 r) = ensureBufferSize x86_max_instruction_bytes >> x86_fp_int_op_membase x86_fdiv r d False++instance Fidiv FPTopReg Ind where+    fidiv32 FPTopReg (Ind (Reg32 r)) = ensureBufferSize x86_max_instruction_bytes >> x86_fp_int_op_membase x86_fdiv r 0 True+    fidiv16 FPTopReg (Ind (Reg32 r)) = ensureBufferSize x86_max_instruction_bytes >> x86_fp_int_op_membase x86_fdiv r 0 False++ class Fdivr a b where     fdivr :: a -> b -> CodeGen e s () @@ -3199,36 +3428,36 @@     fild :: a -> CodeGen e s ()  instance Fild Addr where -    fild (Addr a) = ensureBufferSize x86_max_instruction_bytes >> x86_fild a False+    fild (Addr a) = ensureBufferSize x86_max_instruction_bytes >> x86_fild a FInt32  instance Fild (Disp, Reg32) where -    fild (Disp d, Reg32 r) = ensureBufferSize x86_max_instruction_bytes >> x86_fild_membase r d False+    fild (Disp d, Reg32 r) = ensureBufferSize x86_max_instruction_bytes >> x86_fild_membase r d FInt32  instance Fild Ind where -    fild (Ind (Reg32 r)) = ensureBufferSize x86_max_instruction_bytes >> x86_fild_membase r 0 False+    fild (Ind (Reg32 r)) = ensureBufferSize x86_max_instruction_bytes >> x86_fild_membase r 0 FInt32   class Fist a where     fist :: a -> CodeGen e s ()  instance Fist (Disp, Reg32) where -    fist (Disp d, Reg32 r) = ensureBufferSize x86_max_instruction_bytes >> x86_fist_membase r d False+    fist (Disp d, Reg32 r) = ensureBufferSize x86_max_instruction_bytes >> x86_fist_membase r d FInt32  instance Fist Ind where -    fist (Ind (Reg32 r)) = ensureBufferSize x86_max_instruction_bytes >> x86_fist_membase r 0 False+    fist (Ind (Reg32 r)) = ensureBufferSize x86_max_instruction_bytes >> x86_fist_membase r 0 FInt32   class Fistp a where     fistp :: a -> CodeGen e s ()  instance Fistp Addr where-    fistp (Addr a) = ensureBufferSize x86_max_instruction_bytes >> x86_fist_pop a False+    fistp (Addr a) = ensureBufferSize x86_max_instruction_bytes >> x86_fist_pop a FInt32  instance Fistp (Disp, Reg32) where -    fistp (Disp d, Reg32 r) = ensureBufferSize x86_max_instruction_bytes >> x86_fist_pop_membase r d False+    fistp (Disp d, Reg32 r) = ensureBufferSize x86_max_instruction_bytes >> x86_fist_pop_membase r d FInt32  instance Fistp Ind where -    fistp (Ind (Reg32 r)) = ensureBufferSize x86_max_instruction_bytes >> x86_fist_pop_membase r 0 False+    fistp (Ind (Reg32 r)) = ensureBufferSize x86_max_instruction_bytes >> x86_fist_pop_membase r 0 FInt32   class Sqrtsd a b where@@ -3676,6 +3905,31 @@     maxps (XMMReg xd) (Disp d, Reg32 r) = ensureBufferSize x86_max_instruction_bytes >> x86_max_sse_reg_membase x86_sse_ps xd r d  +class Movss a b where+    movss :: a -> b -> CodeGen e s ()++instance Movss XMMReg XMMReg where+    movss (XMMReg xd) (XMMReg xs) = ensureBufferSize x86_max_instruction_bytes >> x86_mov_sse_reg_reg x86_sse_ss xd xs++instance Movss XMMReg Addr where+    movss (XMMReg xd) (Addr a) = ensureBufferSize x86_max_instruction_bytes >> x86_mov_sse_reg_mem x86_sse_ss xd a++instance Movss Addr XMMReg where+    movss (Addr a) (XMMReg xd) = ensureBufferSize x86_max_instruction_bytes >> x86_mov_sse_mem_reg x86_sse_ss a xd++instance Movss XMMReg Ind where+    movss (XMMReg xd) (Ind (Reg32 r)) = ensureBufferSize x86_max_instruction_bytes >> x86_mov_sse_reg_membase x86_sse_ss xd r 0++instance Movss Ind XMMReg where+    movss (Ind (Reg32 r)) (XMMReg xd) = ensureBufferSize x86_max_instruction_bytes >> x86_mov_sse_membase_reg x86_sse_ss r 0 xd++instance Movss XMMReg (Disp, Reg32) where+    movss (XMMReg xd) (Disp d, Reg32 r) = ensureBufferSize x86_max_instruction_bytes >> x86_mov_sse_reg_membase x86_sse_ss xd r d++instance Movss (Disp, Reg32) XMMReg where+    movss (Disp d, Reg32 r) (XMMReg xd) = ensureBufferSize x86_max_instruction_bytes >> x86_mov_sse_membase_reg x86_sse_ss r d xd++ class Movsd a b where     movsd :: a -> b -> CodeGen e s () @@ -3701,6 +3955,56 @@     movsd (Disp d, Reg32 r) (XMMReg xd) = ensureBufferSize x86_max_instruction_bytes >> x86_mov_sse_membase_reg x86_sse_sd r d xd  +class Movups a b where+    movups :: a -> b -> CodeGen e s ()++instance Movups XMMReg XMMReg where+    movups (XMMReg xd) xs = ensureBufferSize x86_max_instruction_bytes >> x86_movups_to_reg xd (xmmLocLowLevel xs)++instance Movups XMMReg Addr where+    movups (XMMReg xd) xs = ensureBufferSize x86_max_instruction_bytes >> x86_movups_to_reg xd (xmmLocLowLevel xs)++instance Movups Addr XMMReg where+    movups xd (XMMReg xs) = ensureBufferSize x86_max_instruction_bytes >> x86_movups_from_reg xs (xmmLocLowLevel xd)++instance Movups XMMReg Ind where+    movups (XMMReg xd) xs = ensureBufferSize x86_max_instruction_bytes >> x86_movups_to_reg xd (xmmLocLowLevel xs)++instance Movups Ind XMMReg where+    movups xd (XMMReg xs) = ensureBufferSize x86_max_instruction_bytes >> x86_movups_from_reg xs (xmmLocLowLevel xd)++instance Movups XMMReg (Disp, Reg32) where+    movups (XMMReg xd) xs = ensureBufferSize x86_max_instruction_bytes >> x86_movups_to_reg xd (xmmLocLowLevel xs)++instance Movups (Disp, Reg32) XMMReg where+    movups xd (XMMReg xs) = ensureBufferSize x86_max_instruction_bytes >> x86_movups_from_reg xs (xmmLocLowLevel xd)+++class Movlps a b where+    movlps :: a -> b -> CodeGen e s ()++instance Movlps XMMReg XMMReg where+    movlps (XMMReg xd) xs = ensureBufferSize x86_max_instruction_bytes >> x86_movlps_to_reg xd (xmmLocLowLevel xs)++instance Movlps XMMReg Addr where+    movlps (XMMReg xd) xs = ensureBufferSize x86_max_instruction_bytes >> x86_movlps_to_reg xd (xmmLocLowLevel xs)++instance Movlps Addr XMMReg where+    movlps xd (XMMReg xs) = ensureBufferSize x86_max_instruction_bytes >> x86_movlps_from_reg xs (xmmLocLowLevel xd)++instance Movlps XMMReg Ind where+    movlps (XMMReg xd) xs = ensureBufferSize x86_max_instruction_bytes >> x86_movlps_to_reg xd (xmmLocLowLevel xs)++instance Movlps Ind XMMReg where+    movlps xd (XMMReg xs) = ensureBufferSize x86_max_instruction_bytes >> x86_movlps_from_reg xs (xmmLocLowLevel xd)++instance Movlps XMMReg (Disp, Reg32) where+    movlps (XMMReg xd) xs = ensureBufferSize x86_max_instruction_bytes >> x86_movlps_to_reg xd (xmmLocLowLevel xs)++instance Movlps (Disp, Reg32) XMMReg where+    movlps xd (XMMReg xs) = ensureBufferSize x86_max_instruction_bytes >> x86_movlps_from_reg xs (xmmLocLowLevel xd)++ class Comisd a b where     comisd :: a -> b -> CodeGen e s () @@ -3765,6 +4069,49 @@     ucomiss (XMMReg xd) (Disp d, Reg32 r) = ensureBufferSize x86_max_instruction_bytes >> x86_ucomiss_reg_membase xd r d  +class XMMLocation b => XMMLoc a b | a -> b where+    xmmLocLowLevel :: a -> b++instance XMMLoc XMMReg XMMReg where+    xmmLocLowLevel = id++instance XMMLoc Addr Mem where+    xmmLocLowLevel (Addr a) = Mem a++instance XMMLoc Ind MemBase where+    xmmLocLowLevel (Ind (Reg32 r)) = MemBase r 0++instance XMMLoc (Disp, Reg32) MemBase where+    xmmLocLowLevel (Disp d, Reg32 r) = MemBase r d+++haddps :: XMMLoc xmm a => XMMReg -> xmm -> CodeGen e s ()+haddps (XMMReg dreg) reg =+   x86_haddps dreg (xmmLocLowLevel reg)++haddpd :: XMMLoc xmm a => XMMReg -> xmm -> CodeGen e s ()+haddpd (XMMReg dreg) reg =+   x86_haddpd dreg (xmmLocLowLevel reg)+++shufps :: XMMLoc xmm a => XMMReg -> xmm -> Word8 -> CodeGen e s ()+shufps (XMMReg dreg) reg src =+   x86_shufps dreg (xmmLocLowLevel reg) src++shufpd :: XMMLoc xmm a => XMMReg -> xmm -> Word8 -> CodeGen e s ()+shufpd (XMMReg dreg) reg src =+   x86_shufpd dreg (xmmLocLowLevel reg) src+++cvtdq2ps :: XMMLoc xmm a => XMMReg -> xmm -> CodeGen e s ()+cvtdq2ps (XMMReg dreg) reg =+   x86_cvtdq2ps dreg (xmmLocLowLevel reg)++cvttps2dq :: XMMLoc xmm a => XMMReg -> xmm -> CodeGen e s ()+cvttps2dq (XMMReg dreg) reg =+   x86_cvttps2dq dreg (xmmLocLowLevel reg)++ class Prefetchnta a where     prefetchnta :: a -> CodeGen e s () @@ -3813,3 +4160,9 @@ instance Prefetch2 Ind where     prefetch2 (Ind (Reg32 r)) = ensureBufferSize x86_max_instruction_bytes >> x86_prefetch2_regp r ++ptrToWord32 :: Ptr a -> Word32+ptrToWord32 = fromIntegral . ptrToIntPtr++ptrToInt :: Ptr a -> Int+ptrToInt = fromIntegral . ptrToIntPtr

@@ -112,7 +112,7 @@     x86_prolog, x86_epilog, x86_enter, x86_leave,     x86_ret, x86_ret_imm,     -- ** Jump and branch-    x86_jecxz, x86_branch, x86_branch32, x86_branch8,+    x86_jecxz, x86_branch, x86_branch_pointer, x86_branch32, x86_branch8,     x86_jump_membase, x86_jump_pointer, x86_jump_mem, x86_jump_reg,      x86_jump32, x86_jump8,      x86_loopne, x86_loope, x86_loop, @@ -169,10 +169,12 @@     x86_fld, x86_fld_membase, x86_fld80_mem, x86_fld80_membase,     x86_fld_reg, x86_fldz, x86_fld1, x86_fldpi,     x86_fst, x86_fst_membase, x86_fst80_mem, x86_fst80_membase,+    FIntSize(..),     x86_fist_pop, x86_fist_pop_membase, x86_fstsw,      x86_fist_membase, x86_fild, x86_fild_membase,     x86_fsin, x86_fcos, x86_fabs, x86_ftst, x86_fxam, x86_fpatan,      x86_fprem, x86_fprem1, x86_frndint, x86_fsqrt, x86_fptan,+    x86_fincstp, x86_fdecstp,     -- ** SSE instructions     x86_sse_ps, x86_sse_pd, x86_sse_ss, x86_sse_sd,     x86_add_sse_reg_reg, x86_add_sse_reg_mem, x86_add_sse_reg_membase,@@ -187,6 +189,17 @@     x86_ucomiss_reg_reg, x86_ucomiss_reg_mem, x86_ucomiss_reg_membase,     x86_comisd_reg_reg, x86_comisd_reg_mem, x86_comisd_reg_membase,     x86_comiss_reg_reg, x86_comiss_reg_mem, x86_comiss_reg_membase,+    XMMReg(XMMReg), Mem(Mem), MemBase(MemBase),+    XMMLocation(xmm_location_emit),+    x86_movss_to_reg, x86_movss_from_reg,+    x86_movsd_to_reg, x86_movsd_from_reg,+    x86_movlps_to_reg, x86_movlps_from_reg,+    x86_movlpd_to_reg, x86_movlpd_from_reg,+    x86_movups_to_reg, x86_movups_from_reg,+    x86_movupd_to_reg, x86_movupd_from_reg,+    x86_haddps, x86_haddpd,+    x86_shufps, x86_shufpd,+    x86_cvtdq2ps, x86_cvttps2dq,     -- ** Prefetch instructions     x86_prefetch0_mem, x86_prefetch1_mem, x86_prefetch2_mem, x86_prefetchnta_mem,     x86_prefetch0_membase, x86_prefetch1_membase, x86_prefetch2_membase, x86_prefetchnta_membase,@@ -1028,11 +1041,11 @@ x86_fp_op opc index =      do emit8 0xd8        emit8 (0xc0 + (opc `shiftL` 3) + (index .&. 0x07))-x86_fp_op_reg :: Int -> Word8 -> Bool -> CodeGen e s ()+x86_fp_op_reg :: Word8 -> Word8 -> Bool -> CodeGen e s () x86_fp_op_reg opc index pop_stack =        do let  opcMap = [ 0, 1, 2, 3, 5, 4, 7, 6, 8]                emit8 (if pop_stack then 0xde else 0xdc)       -       emit8 (0xc0 + ((opcMap !! opc) `shiftL` 3) + (index .&. 0x07))+       emit8 (0xc0 + ((opcMap !! fromIntegral opc) `shiftL` 3) + (index .&. 0x07))   -- @x86_fp_int_op_membase@@ -1078,6 +1091,9 @@ x86_fucomi index = emit8 0xdb >> emit8 (0xe8 + (index .&. 0x07)) x86_fucomip :: Word8 -> CodeGen e s () x86_fucomip index = emit8 0xdf >> emit8 (0xe8 + (index .&. 0x07))++data FIntSize = FInt16 | FInt32 | FInt64+ x86_fld :: Word32 -> Bool -> CodeGen e s () x86_fld mem is_double =            do emit8 (if is_double then 0xdd else 0xd9)       @@ -1091,16 +1107,18 @@ x86_fld80_membase :: Word8 -> Word32 -> CodeGen e s () x86_fld80_membase basereg disp =           emit8 0xdb >> x86_membase_emit 5 basereg disp     -x86_fild :: Word32 -> Bool -> CodeGen e s ()-x86_fild mem is_long =        -    if is_long-       then emit8 0xdf >> x86_mem_emit 5 mem  -       else emit8 0xdb >> x86_mem_emit 0 mem  -x86_fild_membase :: Word8 -> Word32 -> Bool -> CodeGen e s ()-x86_fild_membase basereg disp is_long =       -    if is_long-       then emit8 0xdf >> x86_membase_emit 5 basereg disp     -       else emit8 0xdb >> x86_membase_emit 0 basereg disp     +x86_fild :: Word32 -> FIntSize -> CodeGen e s ()+x86_fild mem size =+    case size of+       FInt16 -> emit8 0xdf >> x86_mem_emit 0 mem+       FInt32 -> emit8 0xdb >> x86_mem_emit 0 mem+       FInt64 -> emit8 0xdf >> x86_mem_emit 5 mem+x86_fild_membase :: Word8 -> Word32 -> FIntSize -> CodeGen e s ()+x86_fild_membase basereg disp size =+    case size of+       FInt16 -> emit8 0xdb >> x86_membase_emit 0 basereg disp     +       FInt32 -> emit8 0xdb >> x86_membase_emit 0 basereg disp     +       FInt64 -> emit8 0xdf >> x86_membase_emit 5 basereg disp      x86_fld_reg :: Word8 -> CodeGen e s () x86_fld_reg index =        emit8 0xd9 >> emit8 (0xc0 + (index .&. 0x07))@@ -1124,30 +1142,39 @@ x86_fst80_membase :: Word8 -> Word32 -> CodeGen e s () x86_fst80_membase basereg disp =           emit8 0xdb >> x86_membase_emit 7 basereg disp     -x86_fist_pop :: Word32 -> Bool -> CodeGen e s ()-x86_fist_pop mem is_long =    -    if is_long-       then emit8 0xdf >> x86_mem_emit 7 mem  -       else emit8 0xdb >> x86_mem_emit 3 mem  -x86_fist_pop_membase :: Word8 -> Word32 -> Bool -> CodeGen e s ()-x86_fist_pop_membase basereg disp is_long =   -     if is_long-        then emit8 0xdf >> x86_membase_emit 7 basereg disp    -        else emit8 0xdb >> x86_membase_emit 3 basereg disp    +x86_fist_pop :: Word32 -> FIntSize -> CodeGen e s ()+x86_fist_pop mem size =+    case size of+       FInt16 -> emit8 0xdf >> x86_mem_emit 3 mem+       FInt32 -> emit8 0xdb >> x86_mem_emit 3 mem+       FInt64 -> emit8 0xdf >> x86_mem_emit 7 mem+x86_fist_pop_membase :: Word8 -> Word32 -> FIntSize -> CodeGen e s ()+x86_fist_pop_membase basereg disp size =+    case size of+       FInt16 -> emit8 0xdf >> x86_membase_emit 3 basereg disp+       FInt32 -> emit8 0xdb >> x86_membase_emit 3 basereg disp+       FInt64 -> emit8 0xdf >> x86_membase_emit 7 basereg disp x86_fstsw :: CodeGen e s () x86_fstsw = emit8 0x9b >> emit8 0xdf >> emit8 0xe0  -- @x86_fist_membase -- Converts content of ST(0) to integer and stores it at memory location -- addressed by [basereg + disp].--- is_int specifies whether destination is int32 (TRUE) or int16 (FALSE).+-- size specifies whether destination is int32 or int16. -x86_fist_membase :: Word8 -> Word32 -> Bool -> CodeGen e s ()-x86_fist_membase basereg disp is_int =        -    if is_int-       then emit8 0xdb >> x86_membase_emit 2 basereg disp     -       else emit8 0xdf >> x86_membase_emit 2 basereg disp     +x86_fist_membase :: Word8 -> Word32 -> FIntSize -> CodeGen e s ()+x86_fist_membase basereg disp size =        +    case size of+       FInt16 -> emit8 0xdf >> x86_membase_emit 2 basereg disp     +       FInt32 -> emit8 0xdb >> x86_membase_emit 2 basereg disp     +       FInt64 -> error "fist does not support 64 bit access" +x86_fincstp :: CodeGen e s ()+x86_fincstp = emit8 0xd9 >> emit8 0xf7 ++x86_fdecstp :: CodeGen e s ()+x86_fdecstp = emit8 0xd9 >> emit8 0xf6 + -- PUSH instruction.  x86_push_reg :: Word8 -> CodeGen e s ()@@ -1272,6 +1299,14 @@        if x86_is_imm8 offset           then x86_branch8 cond (fromIntegral offset) is_signed           else x86_branch32 cond (fromIntegral (offset - 4)) is_signed++x86_branch_pointer :: Int -> Ptr a -> Bool -> CodeGen e s ()+x86_branch_pointer cond target is_signed =+    do inst <- getCodeOffset+       base <- getBasePtr+       let ptr = base `plusPtr` inst+       x86_branch32 cond (fromIntegral (target `minusPtr` ptr - 5)) is_signed+ {- x86_branch_disp cond disp is_signed =      do let offset = disp - 2@@ -1929,6 +1964,164 @@     do emit8 0x0f        emit8 0x2e        x86_membase_emit dreg basereg disp+++newtype XMMReg = XMMReg Word8+    deriving (Eq, Ord)++newtype Mem = Mem Word32++data MemBase = MemBase Word8 Word32+++class XMMLocation xmm where+   xmm_location_emit :: Word8 -> xmm -> CodeGen e s ()++instance XMMLocation XMMReg where+   xmm_location_emit dreg (XMMReg reg) =+      x86_reg_emit dreg reg++instance XMMLocation Mem where+   xmm_location_emit dreg (Mem mem) =+      x86_mem_emit dreg mem++instance XMMLocation MemBase where+   xmm_location_emit dreg (MemBase basereg disp) =+      x86_membase_emit dreg basereg disp+++x86_movss_to_reg :: XMMLocation xmm => Word8 -> xmm -> CodeGen e s ()+x86_movss_to_reg dreg reg =+    do emit8 0xf3+       emit8 0x0f+       emit8 0x10+       xmm_location_emit dreg reg++x86_movss_from_reg :: XMMLocation xmm => Word8 -> xmm -> CodeGen e s ()+x86_movss_from_reg dreg reg =+    do emit8 0xf3+       emit8 0x0f+       emit8 0x11+       xmm_location_emit dreg reg++x86_movsd_to_reg :: XMMLocation xmm => Word8 -> xmm -> CodeGen e s ()+x86_movsd_to_reg dreg reg =+    do emit8 0xf2+       emit8 0x0f+       emit8 0x10+       xmm_location_emit dreg reg++x86_movsd_from_reg :: XMMLocation xmm => Word8 -> xmm -> CodeGen e s ()+x86_movsd_from_reg dreg reg =+    do emit8 0xf2+       emit8 0x0f+       emit8 0x11+       xmm_location_emit dreg reg+++-- | xmm must not be a register+x86_movlps_to_reg :: XMMLocation xmm => Word8 -> xmm -> CodeGen e s ()+x86_movlps_to_reg dreg reg =+    do emit8 0x0f+       emit8 0x12+       xmm_location_emit dreg reg++-- | xmm must not be a register+x86_movlps_from_reg :: XMMLocation xmm => Word8 -> xmm -> CodeGen e s ()+x86_movlps_from_reg dreg reg =+    do emit8 0x0f+       emit8 0x13+       xmm_location_emit dreg reg++-- | xmm must not be a register+x86_movlpd_to_reg :: XMMLocation xmm => Word8 -> xmm -> CodeGen e s ()+x86_movlpd_to_reg dreg reg =+    do emit8 0x66+       emit8 0x0f+       emit8 0x12+       xmm_location_emit dreg reg++-- | xmm must not be a register+x86_movlpd_from_reg :: XMMLocation xmm => Word8 -> xmm -> CodeGen e s ()+x86_movlpd_from_reg dreg reg =+    do emit8 0x66+       emit8 0x0f+       emit8 0x13+       xmm_location_emit dreg reg+++x86_movups_to_reg :: XMMLocation xmm => Word8 -> xmm -> CodeGen e s ()+x86_movups_to_reg dreg reg =+    do emit8 0x0f+       emit8 0x10+       xmm_location_emit dreg reg++x86_movups_from_reg :: XMMLocation xmm => Word8 -> xmm -> CodeGen e s ()+x86_movups_from_reg dreg reg =+    do emit8 0x0f+       emit8 0x11+       xmm_location_emit dreg reg++x86_movupd_to_reg :: XMMLocation xmm => Word8 -> xmm -> CodeGen e s ()+x86_movupd_to_reg dreg reg =+    do emit8 0x66+       emit8 0x0f+       emit8 0x10+       xmm_location_emit dreg reg++x86_movupd_from_reg :: XMMLocation xmm => Word8 -> xmm -> CodeGen e s ()+x86_movupd_from_reg dreg reg =+    do emit8 0x66+       emit8 0x0f+       emit8 0x11+       xmm_location_emit dreg reg+++x86_haddps :: XMMLocation xmm => Word8 -> xmm -> CodeGen e s ()+x86_haddps dreg reg =+    do emit8 0xf2+       emit8 0x0f+       emit8 0x7c+       xmm_location_emit dreg reg++x86_haddpd :: XMMLocation xmm => Word8 -> xmm -> CodeGen e s ()+x86_haddpd dreg reg =+    do emit8 0x66+       emit8 0x0f+       emit8 0x7c+       xmm_location_emit dreg reg+++x86_shufps :: XMMLocation xmm => Word8 -> xmm -> Word8 -> CodeGen e s ()+x86_shufps dreg reg src =+    do emit8 0x0f+       emit8 0xc6+       xmm_location_emit dreg reg+       emit8 src++x86_shufpd :: XMMLocation xmm => Word8 -> xmm -> Word8 -> CodeGen e s ()+x86_shufpd dreg reg src =+    do emit8 0x66+       emit8 0x0f+       emit8 0xc6+       xmm_location_emit dreg reg+       emit8 src+++x86_cvtdq2ps :: XMMLocation xmm => Word8 -> xmm -> CodeGen e s ()+x86_cvtdq2ps dreg reg =+    do emit8 0x0f+       emit8 0x5b+       xmm_location_emit dreg reg++x86_cvttps2dq :: XMMLocation xmm => Word8 -> xmm -> CodeGen e s ()+x86_cvttps2dq dreg reg =+    do emit8 0xf3+       emit8 0x0f+       emit8 0x5b+       xmm_location_emit dreg reg++  -- ============================================================================= -- Prefetching instructions.

@@ -10,3236 +10,23 @@ -- -- Disassembler for x86 machine code. ----- This is a disassembler for object code for the x86 architecture.--- It provides functions for disassembling byte arrays, byte lists and--- memory blocks containing raw binary code.--- --- Features:------ - Disassembles memory blocks, lists or arrays of bytes into lists of---   instructions.------ - Abstract instructions provide as much information as possible about---   opcodes, addressing modes or operand sizes, allowing for detailed---   output.------ - Provides functions for displaying instructions in Intel or AT&T---   style (like the GNU tools)------ Differences to GNU tools, like gdb or objdump:------ - Displacements are shown in decimal, with sign if negative.------ Missing: ------ - LOCK and repeat prefixes are recognized, but not contained in the---   opcodes of instructions.------ - Support for 16-bit addressing modes.  Could be added when needed.------ - Complete disassembly of all 64-bit instructions.  I have tried to---   disassemble them properly but have been limited to the information---   in the docs, because I have no 64-bit machine to test on.  This will---   probably change when I get GNU as to produce 64-bit object files.------ - Not all MMX and SSE/SSE2/SSE3 instructions are decoded yet.  This is---   just a matter of missing time.------ - segment override prefixes are decoded, but not appended to memory---   references------ On the implementation:------ This disassembler uses the Parsec parser combinators, working on byte--- lists.  This proved to be very convenient, as the combinators keep--- track of the current position, etc.-----------------------------------------------------------------------------module Harpy.X86Disassembler(-  -- * Types-  Opcode,-  Operand(..),-  InstrOperandSize(..),-  Instruction(..),-  ShowStyle(..),-  -- * Functions-  disassembleBlock,-  disassembleList,-  disassembleArray,-  showIntel,-  showAtt-  ) where--import Text.ParserCombinators.Parsec-import Control.Monad.State-import System.IO-import Data.List-import Data.Char-import Data.Array.IArray-import Numeric-import Foreign---- | All opcodes are represented by this enumeration type.--data Opcode = InvalidOpcode-	    | AAA-	    | AAD-	    | AAM-	    | AAS-	    | ADC-	    | ADD-	    | ADDPD-	    | ADDPS-	    | ADDSD-	    | ADDSS-	    | ADDSUBPD-	    | ADDUBPS-	    | AND-	    | ANDNPD-	    | ANDNPS-	    | ANDPD-	    | ANDPS-	    | ARPL-	    | BOUND-	    | BSF-	    | BSR-	    | BT-	    | BTC-	    | BTR-	    | BTS-	    | CALL-	    | CALLF-	    | CBW-	    | CDQ-	    | CDQE-	    | CLC-	    | CLD-	    | CLFLUSH-	    | CLI-	    | CLTS-	    | CMC-	    | CMOVA-	    | CMOVB-	    | CMOVBE-	    | CMOVE-	    | CMOVG-	    | CMOVGE-	    | CMOVL-	    | CMOVLE-	    | CMOVNB-	    | CMOVNE-	    | CMOVNO-	    | CMOVNP-	    | CMOVNS-	    | CMOVO-	    | CMOVP-	    | CMOVS-	    | CMP-	    | CMPS-	    | CMPXCHG-	    | CMPXCHG16B-	    | CMPXCHG8B-	    | COMISD-	    | COMISS-	    | CPUID-	    | CWD-	    | CWDE-	    | DAA-	    | DAS-	    | DEC-	    | DIV-	    | DIVPD-	    | DIVPS-	    | DIVSD-	    | DIVSS-	    | EMMS-	    | ENTER-	    | FABS-	    | FADD-	    | FADDP-	    | FBLD-	    | FBSTP-	    | FCHS-	    | FCLEX-	    | FCMOVB-	    | FCMOVBE-	    | FCMOVE-	    | FCMOVNB-	    | FCMOVNBE-	    | FCMOVNE-	    | FCMOVNU-	    | FCMOVU-	    | FCOM-	    | FCOMI-	    | FCOMIP-	    | FCOMP-	    | FCOMPP-	    | FDIV-	    | FDIVP-	    | FDIVR-	    | FDIVRP-	    | FFREE-	    | FIADD-	    | FICOM-	    | FICOMP-	    | FIDIV-	    | FIDIVR-	    | FILD-	    | FIMUL-	    | FINIT-	    | FIST-	    | FISTP-	    | FISTPP-	    | FISTTP-	    | FISUB-	    | FISUBR-	    | FLD-	    | FLD1-	    | FLDCW-	    | FLDENV-	    | FLDL2E-	    | FLDL2T-	    | FLDLG2-	    | FLDLN2-	    | FLDPI-	    | FLDZ-	    | FMUL-	    | FMULP-	    | FNOP-	    | FRSTOR-	    | FSAVE-	    | FST-	    | FSTCW-	    | FSTENV-	    | FSTP-	    | FSTSW-	    | FSUB-	    | FSUBP-	    | FSUBR-	    | FSUBRP-	    | FTST-	    | FUCOM-	    | FUCOMI-	    | FUCOMIP-	    | FUCOMP-	    | FUCOMPP-	    | FXAM-	    | FXCH-	    | FXRSTOR-	    | FXSAVE-	    | HADDPD-	    | HADDPS-	    | HLT-	    | HSUBPD-	    | HSUBPS-	    | IDIV-	    | IMUL-	    | BSWAP-	    | IN-	    | INC-	    | INS-	    | INT-	    | INT3-	    | INTO-	    | INVD-	    | INVLPG-	    | IRET-	    | JA-	    | JB-	    | JBE-	    | JCXZ-	    | JE-	    | JG-	    | JGE-	    | JL-	    | JLE-	    | JMP-	    | JMPF-	    | JMPN-	    | JNB-	    | JNE-	    | JNO-	    | JNP-	    | JNS-	    | JO-	    | JP-	    | JS-	    | LAHF-	    | LAR-	    | LDDQU-	    | LDMXCSR-	    | LDS-	    | LEA-	    | LEAVE-	    | LES-	    | LFENCE-	    | LFS-	    | LGDT-	    | LGS-	    | LIDT-	    | LLDT-	    | LMSW-	    | LODS-	    | LOOP-	    | LOOPE-	    | LOOPNE-	    | LSL-	    | LSS-	    | LTR-	    | MASKMOVQ-	    | MAXPD-	    | MAXPS-	    | MAXSD-	    | MAXSS-	    | MFENCE-	    | MINPD-	    | MINPS-	    | MINSD-	    | MINSS-	    | MONITOR-	    | MOV -	    | MOVAPD-	    | MOVAPS-	    | MOVDDUP-	    | MOVHPD-	    | MOVHPS-	    | MOVLHPS-	    | MOVLPD-	    | MOVLPS-	    | MOVLSDUP-	    | MOVMSKPD-	    | MOVMSKPS-	    | MOVNTDQ-	    | MOVNTPD-	    | MOVNTPS-	    | MOVNTQ-	    | MOVQ-	    | MOVS-	    | MOVSD-	    | MOVSLDUP-	    | MOVSS-	    | MOVSXB-	    | MOVSXD-	    | MOVSXW-	    | MOVUPD-	    | MOVUPS-	    | MOVZXB-	    | MOVZXW-	    | MUL-	    | MULPD-	    | MULPS-	    | MULSD-	    | MULSS-	    | MWAIT-	    | NEG-	    | NOP-	    | NOT-	    | OR-	    | ORPD-	    | ORPS-	    | OUT-	    | OUTS-	    | PADDB-	    | PADDD-	    | PADDQ-	    | PADDSB-	    | PADDSW-	    | PADDUSB-	    | PADDUSW-	    | PADDW-	    | PAND-	    | PANDN-	    | PAUSE-	    | PAVGB-	    | PAVGW-	    | PMADDWD-	    | PMAXSW-	    | PMAXUB-	    | PMINSW-	    | PMINUB-	    | PMOVMSKB-	    | PMULHUW-	    | PMULHW-	    | PMULLW-	    | PMULUDQ-	    | POP-	    | POPA-	    | POPAD-	    | POPF-	    | POPFD-	    | POPFQ-	    | POR-	    | PREFETCHNTA-	    | PREFETCHT0-	    | PREFETCHT1-	    | PREFETCHT2-	    | PSADBW-	    | PSLLD-	    | PSLLDQ-	    | PSLLQ-	    | PSLLW-	    | PSRAD-	    | PSRAW-	    | PSRLD-	    | PSRLDQ-	    | PSRLQ-	    | PSRLW-	    | PSUBB-	    | PSUBD-	    | PSUBQ-	    | PSUBSB-	    | PSUBSQ-	    | PSUBUSB-	    | PSUBUSW-	    | PSUBW-	    | PUSH-	    | PUSHA-	    | PUSHAD-	    | PUSHF-	    | PUSHFD-	    | PUSHFQ-	    | PXOR-	    | RCL-	    | RCPPS-	    | RCPSS-	    | RCR-	    | RDMSR-	    | RDPMC-	    | RDTSC-	    | RET-	    | RETF-	    | ROL-	    | ROR-	    | RSM-	    | RSQRTPS-	    | RSQRTSS-	    | SAHF-	    | SAR-	    | SBB-	    | SCAS-	    | SETA-	    | SETB-	    | SETBE-	    | SETE-	    | SETG-	    | SETGE-	    | SETL-	    | SETLE-	    | SETNB-	    | SETNE-	    | SETNO-	    | SETNP-	    | SETNS-	    | SETO-	    | SETP-	    | SETS-	    | SFENCE-	    | SGDT-	    | SHL-	    | SHLD-	    | SHR-	    | SHRD-	    | SIDT-	    | SLDT-	    | SMSW-	    | SQRTPD-	    | SQRTPS-	    | SQRTSD-	    | SQRTSS-	    | STC-	    | STD-	    | STI-	    | STMXCSR-	    | STOS-	    | STR-	    | SUB-	    | SUBPD-	    | SUBPS-	    | SUBSD-	    | SUBSS-	    | SWAPGS-	    | SYSCALL-	    | SYSENTER-	    | SYSEXIT-	    | TEST-	    | UCOMISD-	    | UCOMISS-	    | UD2-	    | UNPCKHPD-	    | UNPCKHPS-	    | UNPCKLPD-	    | UNPCKLPS-	    | VERR-	    | VERW-	    | VMCALL-	    | VMCLEAR-	    | VMLAUNCH-	    | VMPTRLD-	    | VMPTRST-	    | VMREAD-	    | VMRESUME-	    | VMWRITE-	    | VMXOFF-	    | VMXON-	    | WAIT-	    | WBINVD-	    | WRMSR-	    | XADD-	    | XCHG-	    | XLAT-	    | XOR-	    | XORPD-	    | XORPS-  deriving (Show, Eq)---- Display an opcode in lower case.--showOp :: Opcode -> String-showOp = (map toLower) . show---- | All operands are in one of the following locations:------ - Constants in the instruction stream------ - Memory locations------ - Registers------ Memory locations are referred to by on of several addressing modes:------ - Absolute (address in instruction stream)------ - Register-indirect (address in register)------ - Register-indirect with displacement------ - Base-Index with scale------ - Base-Index with scale and displacement ------ Displacements can be encoded as 8 or 32-bit immediates in the--- instruction stream, but are encoded as Int in instructions for--- simplicity.----data Operand = OpImm Word32		-- ^ Immediate value-              | OpAddr Word32 InstrOperandSize -- ^ Absolute address-              | OpReg String Int	-- ^ Register-              | OpFPReg Int		-- ^ Floating-point register-              | OpInd String InstrOperandSize -- ^Register-indirect-              | OpIndDisp String Int InstrOperandSize-	        -- ^ Register-indirect with displacement-              | OpBaseIndex String String Int InstrOperandSize-        				-- ^ Base plus scaled index-              | OpIndexDisp String Int Int InstrOperandSize-       		 -- ^ Scaled index with displacement-              | OpBaseIndexDisp String String Int Int InstrOperandSize-       		 -- ^ Base plus scaled index with displacement-  deriving (Eq)---- Show an operand in AT&T style.--showAttOps (OpImm w) = showImm w-showAttOps (OpAddr w _) = showAddr w-showAttOps (OpReg s num) = "%" ++ s-showAttOps (OpFPReg 0) = "%st"-showAttOps (OpFPReg i) = "%st(" ++ show i ++ ")"-showAttOps (OpInd s _) = "(%" ++ s ++ ")"-showAttOps (OpIndDisp s disp _) = show disp ++ "(%" ++ s ++ ")"-showAttOps (OpBaseIndex b i s _) = "(%" ++ b ++ ",%" ++ i ++ "," ++ show s ++ ")"-showAttOps (OpIndexDisp i s disp _) = show disp ++ "(%" ++ i ++ "," ++ -  show s ++ ")"-showAttOps (OpBaseIndexDisp b i s disp _) = show disp ++ "(%" ++ b ++ ",%" ++ -  i ++ "," ++ show s ++ ")"---- Show an operand in Intel style.--showIntelOps opsize (OpImm w) = showIntelImm w-showIntelOps opsize (OpAddr w sz) = opInd sz ++ "[" ++ showIntelAddr w ++ "]"-showIntelOps opsize (OpReg s num) = s-showIntelOps opsize (OpFPReg 0) = "st"-showIntelOps opsize (OpFPReg i) = "st(" ++ show i ++ ")"-showIntelOps opsize (OpInd s sz) = opInd sz ++ "[" ++ s ++ "]"-showIntelOps opsize (OpIndDisp s disp sz) = -    opInd sz ++ "[" ++ s ++ -       (if disp < 0 then "" else "+") ++ show disp ++ "]"-showIntelOps opsize (OpBaseIndex b i s sz) = -    opInd sz ++ "[" ++ b ++ "+" ++ i ++ "*" ++ show s ++ "]"-showIntelOps opsize (OpIndexDisp i s disp sz) = -    opInd sz ++ "[" ++ i ++ "*" ++ show s ++ -       (if disp < 0 then "" else "+") ++ show disp ++ "]"-showIntelOps opsize (OpBaseIndexDisp b i s disp sz) = -    opInd sz ++ "[" ++ b ++ "+" ++ i ++ "*" ++ show s ++ -       (if disp < 0 then "" else "+") ++ -      show disp ++ "]"-opInd OPNONE = ""-opInd OP8 = "byte ptr "-opInd OP16 = "word ptr "-opInd OP32 = "dword ptr "-opInd OPF32 = "dword ptr "-opInd OP64 = "qword ptr "-opInd OPF64 = "qword ptr "-opInd OPF80 = "tbyte ptr "-opInd OP128 = "dqword ptr "---- | Encodes the default and currently active operand or address size.  Can--- be changed with the operand- or address-size prefixes 0x66 and 0x67.--data OperandSize = BIT16 | BIT32---- | Some opcodes can operate on data of several widths.  This information--- is encoded in instructions using the following enumeration type..--data InstrOperandSize = OPNONE -- ^ No operand size specified-       	        | OP8 	       -- ^ 8-bit integer operand-       	        | OP16 	       -- ^ 16-bit integer operand-       	        | OP32	       -- ^ 32-bit integer operand-       	        | OP64	       -- ^ 64-bit integer operand-       	        | OP128	       -- ^ 128-bit integer operand-       	        | OPF32	       -- ^ 32-bit floating point operand-       	        | OPF64	       -- ^ 64-bit floating point operand-       	        | OPF80	       -- ^ 80-bit floating point operand-  deriving (Show, Eq)----- | The disassembly routines return lists of the following datatype.  It--- encodes both invalid byte sequences (with a useful error message, if--- possible), or a valid instruction.  Both variants contain the list of--- opcode bytes from which the instruction was decoded and the address of--- the instruction.--data Instruction = -    BadInstruction Word8 String Int [Word8]   -- ^ Invalid instruction-  | PseudoInstruction Int String                  -- ^ Pseudo instruction, e.g. label-  | Instruction { opcode :: Opcode, 	      -- ^ Opcode of the instruction-       		  opsize :: InstrOperandSize, -- ^ Operand size, if any-       		  operands :: [Operand],      -- ^ Instruction operands-                  address :: Int,             -- ^ Start address of instruction-       		  bytes ::[Word8]	      -- ^ Instruction bytes-                 }			      -- ^ Valid instruction-  deriving (Eq)--instance Show Instruction where-    show = showIntel--data Instr = Bad Word8 String-            | Instr Opcode InstrOperandSize [Operand]---- Show an integer as an 8-digit hexadecimal number with leading zeroes.--hex32 :: Int -> String-hex32 i =-    let w :: Word32-        w = fromIntegral i-        s = showHex w ""-    in take (8 - length s) (repeat '0') ++ s---- Show a byte as an 2-digit hexadecimal number with leading zeroes.--hex8 :: Word8 -> String-hex8 i =-    let s = showHex i ""-    in take (2 - length s) ['0','0'] ++ s----- | Instructions can be displayed either in Intel or AT&T style (like in--- GNU tools).------ Intel style:------ - Destination operand comes first, source second.------ - No register or immediate prefixes.------ - Memory operands are annotated with operand size.------ - Hexadecimal numbers are suffixed with @H@ and prefixed with @0@ if---   necessary.------ AT&T style:------ - Source operand comes first, destination second.------ - Register names are prefixes with @%@.------ - Immediates are prefixed with @$@.------ - Hexadecimal numbers are prefixes with @0x@------ - Opcodes are suffixed with operand size, when ambiguous otherwise.-data ShowStyle = IntelStyle		-- ^ Show in Intel style-                | AttStyle		-- ^ Show in AT&T style---- | Show an instruction in Intel style.--showIntel :: Instruction -> [Char]-showIntel (BadInstruction b desc pos bytes) =-    showPosBytes pos bytes ++-    "(" ++ desc ++ ", byte=" ++ show b ++ ")"-showIntel (PseudoInstruction pos s) =-    hex32 pos ++ "                          " ++ s-showIntel (Instruction op opsize [] pos bytes) = -    showPosBytes pos bytes ++-       showOp op-showIntel (Instruction op opsize ops pos bytes) = -    showPosBytes pos bytes ++-        enlarge (showOp op) 6 ++ " " ++-       concat (intersperse "," (map (showIntelOps opsize) ops))---- | Show an instruction in AT&T style.--showAtt :: Instruction -> [Char]-showAtt (BadInstruction b desc pos bytes) = -    showPosBytes pos bytes ++-       "(" ++ desc ++ ", byte=" ++ show b ++ ")"-showAtt (PseudoInstruction pos s) =-    hex32 pos ++ "                          " ++ s-showAtt (Instruction op opsize [] pos bytes) = -    showPosBytes pos bytes ++-       showOp op ++ showInstrSuffix [] opsize-showAtt (Instruction op opsize ops pos bytes) = -    showPosBytes pos bytes ++-       enlarge (showOp op ++ showInstrSuffix ops opsize) 6 ++ " " ++-       concat (intersperse "," (map showAttOps (reverse ops)))--showPosBytes pos bytes =-    hex32 pos ++ "  " ++ -      enlarge (concat (intersperse " " (map hex8 bytes))) 30--enlarge s i = s ++ take (i - length s) (repeat ' ')--opSizeSuffix OPNONE = ""-opSizeSuffix OP8 = "b"-opSizeSuffix OP16 = "w"-opSizeSuffix OP32 = "l"-opSizeSuffix OP64 = "q"-opSizeSuffix OP128 = "dq"-opSizeSuffix OPF32 = "s"-opSizeSuffix OPF64 = "l"-opSizeSuffix OPF80 = "t"--showInstrSuffix [] sz = opSizeSuffix sz-showInstrSuffix ((OpImm _) : os) s = showInstrSuffix os s---showInstrSuffix ((OpReg _ _) : []) s = ""-showInstrSuffix ((OpReg _ _) : os) s = showInstrSuffix os OPNONE-showInstrSuffix ((OpFPReg _) : os) s = showInstrSuffix os s-showInstrSuffix ((OpAddr _ OPNONE) : os) s = showInstrSuffix os s-showInstrSuffix ((OpAddr _ sz) : os) s = opSizeSuffix sz-showInstrSuffix ((OpInd _ OPNONE) : os) s = showInstrSuffix os s-showInstrSuffix ((OpInd _ sz) : os) s = opSizeSuffix sz-showInstrSuffix ((OpIndDisp _ _ OPNONE) : os) s = showInstrSuffix os s-showInstrSuffix ((OpIndDisp _ _ sz) : os) s = opSizeSuffix sz-showInstrSuffix ((OpBaseIndex _ _ _ OPNONE) : os) s = showInstrSuffix os s-showInstrSuffix ((OpBaseIndex _ _ _ sz) : os) s = opSizeSuffix sz-showInstrSuffix ((OpIndexDisp _ _ _ OPNONE) : os) s = showInstrSuffix os s-showInstrSuffix ((OpIndexDisp _ _ _ sz) : os) s = opSizeSuffix sz-showInstrSuffix ((OpBaseIndexDisp _ _ _ _ OPNONE) : os) s = showInstrSuffix os s-showInstrSuffix ((OpBaseIndexDisp _ _ _ _ sz) : os) s = opSizeSuffix sz---- showInstrOperandSize ops OPNONE | noRegop ops = ""--- showInstrOperandSize ops OP8 | noRegop ops = "b"--- showInstrOperandSize ops OP16 | noRegop ops = "w"--- showInstrOperandSize ops OP32 | noRegop ops = "l"--- showInstrOperandSize ops OPF32 | noRegop ops = "s"--- showInstrOperandSize ops OP64 | noRegop ops = "q"--- showInstrOperandSize ops OPF64 | noRegop ops = "l"--- showInstrOperandSize ops OPF80 | noRegop ops = "e"--- showInstrOperandSize ops OP128 | noRegop ops = ""--- showInstrOperandSize _ _ = ""---- noRegop ops = null (filter isRegop ops)--- isRegop (OpReg _ _) = True--- isRegop _ = False---- Show an immediate value in hexadecimal.--showImm :: Word32 -> String-showImm i =-  "$0x" ++ showHex i ""--showIntelImm :: Word32 -> String-showIntelImm i =-  let h = showHex i "H"-      (f:_) = h-  in (if isDigit f then "" else "0") ++ h---- Show an address in hexadecimal.--showAddr i =  -  let w :: Word32-      w = fromIntegral i-  in "0x" ++ showHex w ""-showIntelAddr i = -  let w :: Word32-      w = fromIntegral i-      h = showHex w "H"-      (f:_) = h-  in (if isDigit f then "" else "0") ++ h---- | Disassemble a block of memory.  Starting at the location--- pointed to by the given pointer, the given number of bytes are--- disassembled.--disassembleBlock :: Ptr Word8 -> Int -> IO (Either ParseError [Instruction])-disassembleBlock ptr len = do-  l <- toList ptr len 0 []-  parseInstructions -    defaultState{startAddr = fromIntegral (minusPtr ptr nullPtr)} (reverse l)-  where -  toList :: (Ptr Word8) -> Int -> Int -> [Word8] -> IO [Word8]-  toList ptr len idx acc | idx < len =-       	   do p <- peekByteOff ptr idx-       	      toList ptr len (idx + 1) (p : acc)---       	      return (p : r)-  toList ptr len idx acc | idx >= len = return acc---- | Disassemble the contents of the given array.--disassembleArray :: (Monad m, IArray a Word8, Ix i) =>-                    a i Word8 -> m (Either ParseError [Instruction])-disassembleArray arr =-  let l = elems arr-  in parseInstructions defaultState l---- | Disassemble the contents of the given list.--disassembleList :: (Monad m) =>-                   [Word8] -> m (Either ParseError [Instruction])-disassembleList ls =-    parseInstructions defaultState ls--disassembleFile filename = do-  l <- readFile filename-  parseInstructions defaultState (map (fromIntegral . ord) l)--instrToString insts style =-  map showInstr insts- where- showInstr = case style of-       	  IntelStyle -> showIntel-       	  AttStyle -> showAtt---- | Test function for disassembling the contents of a binary file and--- displaying it in the provided style ("IntelStyle" or "AttStyle").--testFile :: FilePath -> ShowStyle -> IO ()-testFile fname style = do-  l <- readFile fname-  i <- parseInstructions defaultState (map (fromIntegral . ord) l)-  case i of-    Left err -> putStrLn (show err)-    Right i' -> mapM_ (putStrLn . showInstr) i'- where- showInstr = case style of-       	  IntelStyle -> showIntel-       	  AttStyle -> showAtt---- This is the state maintained by the disassembler.--data PState = PState { defaultBitMode :: OperandSize,-       	         operandBitMode :: OperandSize,-       	         addressBitMode :: OperandSize,-       	         in64BitMode :: Bool,-                        prefixes :: [Word8],-       	         startAddr :: Word32-                      }---- Default state to be used if no other is given to the disassembly--- routines.--defaultState = PState { defaultBitMode = BIT32,-       	          operandBitMode = BIT32, -       	          addressBitMode = BIT32, -       	          in64BitMode = False,-       	          prefixes = [],-       	          startAddr = 0}--type Word8Parser a = GenParser Word8 PState a--parseInstructions st l =-    return (runParser instructionSequence st "memory block" l)---- Parse a possibly empty sequence of instructions.--instructionSequence = many instruction---- Parse a single instruction.  The result is either a valid instruction--- or an indicator that there starts no valid instruction at the current--- position.--instruction = do-    startPos' <- getPosition-    let startPos = sourceColumn startPos' - 1-    input <- getInput-    st <- getState-    setState st{operandBitMode = defaultBitMode st,-                 addressBitMode = defaultBitMode st,-               prefixes = []}-    many parsePrefix-    b <- anyWord8-    case lookup b oneByteOpCodeMap of-      Just p -> do i <- p b-       		   endPos' <- getPosition-       		   let endPos = sourceColumn endPos' - 1-		   case i of-       		     Instr oc opsize ops -> do-       	               return $ Instruction oc opsize ops-       		            (fromIntegral (startAddr st) + startPos)-       		            (take (endPos - startPos) input)-       	             Bad b desc ->-       	               return $ BadInstruction b desc -       		            (fromIntegral (startAddr st) + startPos)-       		            (take (endPos - startPos) input)-      Nothing -> do Bad b desc <- parseInvalidOpcode b-		    endPos' <- getPosition-       		    let endPos = sourceColumn endPos' - 1-       		    return $ BadInstruction b desc -       	                (fromIntegral (startAddr st) + startPos)-       		        (take (endPos - startPos) input)--toggleBitMode BIT16 = BIT32-toggleBitMode BIT32 = BIT16--rex_B = 0x1-rex_X = 0x2-rex_R = 0x4-rex_W = 0x8---- Return True if the given REX prefix bit appears in the list of current--- instruction prefixes, False otherwise.--hasREX rex st =-    let rexs = filter (\ b -> b >= 0x40 && b <= 0x4f) (prefixes st) in-       case rexs of-         (r : _) -> if r .&. rex == rex then True else False-         _ -> False---- Return True if the given prefix appears in the list of current--- instruction prefixes, False otherwise.--hasPrefix b st = b `elem` prefixes st--addPrefix b = do-    st <- getState-    setState st{prefixes = b : prefixes st}---- Parse a single prefix byte and remember it in the parser state.  If in--- 64-bit mode, accept REX prefixes.--parsePrefix = do-    (word8 0xf0 >>= addPrefix) -- LOCK-  <|>-    (word8 0xf2 >>= addPrefix) -- REPNE/REPNZ-  <|>-    (word8 0xf3 >>= addPrefix) -- REP or REPE/REPZ-  <|>-    (word8 0x2e >>= addPrefix) -- CS segment override-  <|>-    (word8 0x36 >>= addPrefix) -- SS segment override-  <|>-    (word8 0x3e >>= addPrefix) -- DS segment override-  <|>-    (word8 0x26 >>= addPrefix) -- ES segment override-  <|>-    (word8 0x64 >>= addPrefix) -- FS segment override-  <|>-    (word8 0x65 >>= addPrefix) -- GS segment override-  <|>-    (word8 0x2e >>= addPrefix) -- branch not taken-  <|>-    (word8 0x3e >>= addPrefix) -- branch taken-  <|>-    do word8 0x66 -- operand-size override-       st <- getState-       setState st{operandBitMode = toggleBitMode (operandBitMode st)}-       addPrefix 0x66-  <|>-    do word8 0x67 -- address-size override-       st <- getState-       setState st{addressBitMode = toggleBitMode (addressBitMode st)}-       addPrefix 0x66-  <|>  do st <- getState-          if in64BitMode st -            then    (word8 0x40 >>= addPrefix)-                     <|>-                     (word8 0x41 >>= addPrefix)-                     <|>-                     (word8 0x42 >>= addPrefix)-                     <|>-                     (word8 0x43 >>= addPrefix)-                     <|>-                     (word8 0x44 >>= addPrefix)-                     <|>-                     (word8 0x45 >>= addPrefix)-                     <|>-                     (word8 0x46 >>= addPrefix)-                     <|>-                     (word8 0x47 >>= addPrefix)-                     <|>-                     (word8 0x48 >>= addPrefix)-                     <|>-                     (word8 0x49 >>= addPrefix)-                     <|>-                     (word8 0x4a >>= addPrefix)-                     <|>-                     (word8 0x4b >>= addPrefix)-                     <|>-                     (word8 0x4c >>= addPrefix)-                     <|>-                     (word8 0x4d >>= addPrefix)-                     <|>-                     (word8 0x4e >>= addPrefix)-                     <|>-                     (word8 0x4f >>= addPrefix)-             else pzero---- Accept the single unsigned byte B.--word8 b = do-    tokenPrim showByte nextPos testByte-  where-  showByte by = show by-  nextPos pos x xs = incSourceColumn pos 1-  testByte by = if b == by then Just by else Nothing---- Accept and return a single unsigned byte.--anyWord8 :: Word8Parser Word8-anyWord8 = do-    tokenPrim showByte nextPos testByte-  where-  showByte by = show by-  nextPos pos x xs = incSourceColumn pos 1-  testByte by =  Just by---- Accept any 8-bit signed byte.--anyInt8 :: Word8Parser Int8-anyInt8 = do-   b <- anyWord8-   let i :: Int8-       i = fromIntegral b-   return i---- Accept any 16-bit unsigned word.--anyWord16 = do-     b0 <- anyWord8-     b1 <- anyWord8-     let w0, w1 :: Word16-         w0 = fromIntegral b0-         w1 = fromIntegral b1-     return $ w0 .|. (w1 `shiftL` 8)---- Accept any 16-bit signed integer.--anyInt16 = do-     b0 <- anyWord16-     let w0 :: Int16-         w0 = fromIntegral b0-     return $ w0---- Accept a 32-bit unsigned word.--anyWord32 = do-     b0 <- anyWord16-     b1 <- anyWord16-     let w0, w1 :: Word32-         w0 = fromIntegral b0-         w1 = fromIntegral b1-     return $ w0 .|. (w1 `shiftL` 16)---- Accept a 32-bit signed integer.--anyInt32 :: Word8Parser Int32-anyInt32 = do-     b0 <- anyWord32-     let w0 :: Int32-         w0 = fromIntegral b0-     return $ w0---- Accept a 64-bit unsigned word.--anyWord64 :: Word8Parser Word64-anyWord64 = do-     b0 <- anyWord32-     b1 <- anyWord32-     let w0, w1 :: Word64-         w0 = fromIntegral b0-         w1 = fromIntegral b1-     return $ w0 .|. (w1 `shiftL` 32)---- Accept a 64-bit signed integer.--anyInt64 :: Word8Parser Int64-anyInt64 = do-     b0 <- anyWord64-     let w0 :: Int64-         w0 = fromIntegral b0-     return $ w0---- Accept a 16-bit word for 16-bit operand-size, a 32-bit word for--- 32-bit operand-size, or a 64-bit word in 64-bit mode.--anyWordV :: Word8Parser Word64-anyWordV = do-    st <- getState-    if in64BitMode st-       then do w <- anyWord64-               return w-        else case operandBitMode st of-              BIT16 -> do w <- anyWord16-       	                  let w' :: Word64-       	                      w' = fromIntegral w-       	                  return w'-              BIT32 -> do w <- anyWord32-       	                  let w' :: Word64-       	                      w' = fromIntegral w-       	                  return w'---- Accept a 16-bit word for 16-bit operand-size or a 32-bit word for--- 32-bit operand-size or 64-bit mode.--anyWordZ :: Word8Parser Word32-anyWordZ = do-    st <- getState-    case operandBitMode st of-      BIT16 -> do -        w <- anyWord16-       	let w' :: Word32-       	    w' = fromIntegral w-       	return w'-      BIT32 -> anyWord32---- Accept a 16-bit integer for 16-bit operand-size or a 32-bit word for--- 32-bit operand-size or 64-bit mode.--anyIntZ :: Word8Parser Int32-anyIntZ = do-    st <- getState-    case operandBitMode st of-      BIT16 -> do -        w <- anyInt16-       	let w' :: Int32-       	    w' = fromIntegral w-       	return w'-      BIT32 -> anyInt32---- Accept a 32-bit far address for 16-bit operand-size or a 48-bit far--- address for 32-bit operand-size.--anyWordP :: Word8Parser Word64-anyWordP = do-    st <- getState-    case operandBitMode st of-      BIT16 -> do w <- anyWord32-       	          let w' :: Word64-       	              w' = fromIntegral w-		  return w'-      _ -> do w1 <- anyWord32-       	      w2 <- anyWord16-              let w1', w2' :: Word64-       	          w1' = fromIntegral w1-                  w2' = fromIntegral w2-       	      return (w1' .|. (w2' `shiftL` 32))--oneByteOpCodeMap =-    [(0x00, parseALU ADD),-     (0x01, parseALU ADD),-     (0x02, parseALU ADD),-     (0x03, parseALU ADD),-     (0x04, parseALU ADD),-     (0x05, parseALU ADD),-     (0x06, invalidIn64BitMode (parsePUSHSeg "es")),-     (0x07, invalidIn64BitMode (parsePOPSeg "es")),-     (0x08, parseALU OR),-     (0x09, parseALU OR),-     (0x0a, parseALU OR),-     (0x0b, parseALU OR),-     (0x0c, parseALU OR),-     (0x0d, parseALU OR),-     (0x0e, invalidIn64BitMode (parsePUSHSeg "cs")),-     (0x0f, twoByteEscape),--     (0x10, parseALU ADC),-     (0x11, parseALU ADC),-     (0x12, parseALU ADC),-     (0x13, parseALU ADC),-     (0x14, parseALU ADC),-     (0x15, parseALU ADC),-     (0x16, invalidIn64BitMode (parsePUSHSeg "ss")),-     (0x17, invalidIn64BitMode (parsePOPSeg "ss")),-     (0x18, parseALU SBB),-     (0x19, parseALU SBB),-     (0x1a, parseALU SBB),-     (0x1b, parseALU SBB),-     (0x1c, parseALU SBB),-     (0x1d, parseALU SBB),-     (0x1e, invalidIn64BitMode (parsePUSHSeg "ds")),-     (0x1f, invalidIn64BitMode (parsePOPSeg "ds")),--     (0x20, parseALU AND),-     (0x21, parseALU AND),-     (0x22, parseALU AND),-     (0x23, parseALU AND),-     (0x24, parseALU AND),-     (0x25, parseALU AND),-     (0x26, parseInvalidPrefix), -- ES segment override prefix-     (0x27, invalidIn64BitMode (parseGeneric DAA OPNONE)),-     (0x28, parseALU SUB),-     (0x29, parseALU SUB),-     (0x2a, parseALU SUB),-     (0x2b, parseALU SUB),-     (0x2c, parseALU SUB),-     (0x2d, parseALU SUB),-     (0x2e, parseInvalidPrefix), -- CS segment override prefix-     (0x2f, invalidIn64BitMode (parseGeneric DAS OPNONE)),--     (0x30, parseALU XOR),-     (0x31, parseALU XOR),-     (0x32, parseALU XOR),-     (0x33, parseALU XOR),-     (0x34, parseALU XOR),-     (0x35, parseALU XOR),-     (0x36, parseInvalidPrefix), -- SS segment override prefix-     (0x37, invalidIn64BitMode (parseGeneric AAA OPNONE)),-     (0x38, parseALU CMP),-     (0x39, parseALU CMP),-     (0x3a, parseALU CMP),-     (0x3b, parseALU CMP),-     (0x3c, parseALU CMP),-     (0x3d, parseALU CMP),-     (0x3e, parseInvalidPrefix), -- DS segment override prefix-     (0x3f, invalidIn64BitMode (parseGeneric AAS OPNONE)),--     (0x40, invalidIn64BitMode parseINC), -- REX Prefix in 64-bit mode-     (0x41, invalidIn64BitMode parseINC), -- ...-     (0x42, invalidIn64BitMode parseINC),-     (0x43, invalidIn64BitMode parseINC),-     (0x44, invalidIn64BitMode parseINC),-     (0x45, invalidIn64BitMode parseINC),-     (0x46, invalidIn64BitMode parseINC),-     (0x47, invalidIn64BitMode parseINC),-     (0x48, invalidIn64BitMode parseDEC),-     (0x49, invalidIn64BitMode parseDEC),-     (0x4a, invalidIn64BitMode parseDEC),-     (0x4b, invalidIn64BitMode parseDEC),-     (0x4c, invalidIn64BitMode parseDEC),-     (0x4d, invalidIn64BitMode parseDEC),-     (0x4e, invalidIn64BitMode parseDEC),-     (0x4f, invalidIn64BitMode parseDEC),--     (0x50, parsePUSH),-     (0x51, parsePUSH),-     (0x52, parsePUSH),-     (0x53, parsePUSH),-     (0x54, parsePUSH),-     (0x55, parsePUSH),-     (0x56, parsePUSH),-     (0x57, parsePUSH),-     (0x58, parsePOP),-     (0x59, parsePOP),-     (0x5a, parsePOP),-     (0x5b, parsePOP),-     (0x5c, parsePOP),-     (0x5d, parsePOP),-     (0x5e, parsePOP),-     (0x5f, parsePOP),--     (0x60, invalidIn64BitMode parsePUSHA),-     (0x61, invalidIn64BitMode parsePOPA),-     (0x62, invalidIn64BitMode parseBOUND),-     (0x63, choose64BitMode parseARPL parseMOVSXD), -- MOVSXD in 64-bit mode-     (0x64, parseInvalidPrefix), -- FS segment override prefix-     (0x65, parseInvalidPrefix), -- GS segment override prefix-     (0x66, parseInvalidPrefix), -- operand-size prefix-     (0x67, parseInvalidPrefix), -- address-size prefix-     (0x68, parsePUSHImm),-     (0x69, parseIMUL),-     (0x6a, parsePUSHImm),-     (0x6b, parseIMUL),-     (0x6c, parseINS),-     (0x6d, parseINS),-     (0x6e, parseOUTS),-     (0x6f, parseOUTS),--     (0x70, parseJccShort),-     (0x71, parseJccShort),-     (0x72, parseJccShort),-     (0x73, parseJccShort),-     (0x74, parseJccShort),-     (0x75, parseJccShort),-     (0x76, parseJccShort),-     (0x77, parseJccShort),-     (0x78, parseJccShort),-     (0x79, parseJccShort),-     (0x7a, parseJccShort),-     (0x7b, parseJccShort),-     (0x7c, parseJccShort),-     (0x7d, parseJccShort),-     (0x7e, parseJccShort),-     (0x7f, parseJccShort),--     (0x80, parseGrp1),-     (0x81, parseGrp1),-     (0x82, invalidIn64BitMode parseGrp1),-     (0x83, parseGrp1),-     (0x84, parseTEST),-     (0x85, parseTEST),-     (0x86, parseXCHG),-     (0x87, parseXCHG),-     (0x88, parseMOV),-     (0x89, parseMOV),-     (0x8a, parseMOV),-     (0x8b, parseMOV),-     (0x8c, parseMOV),-     (0x8d, parseLEA),-     (0x8e, parseMOV),-     (0x8f, parseGrp1A),--     (0x90, parse0x90), -- NOP, PAUSE(F3), XCHG r8,rAX-     (0x91, parseXCHGReg),-     (0x92, parseXCHGReg),-     (0x93, parseXCHGReg),-     (0x94, parseXCHGReg),-     (0x95, parseXCHGReg),-     (0x96, parseXCHGReg),-     (0x97, parseXCHGReg),-     (0x98, parseCBW_CWDE_CDQE),-     (0x99, parseCWD_CDQ_CQO),-     (0x9a, invalidIn64BitMode parseCALLF),-     (0x9b, parseGeneric WAIT OPNONE),-     (0x9c, parsePUSHF),-     (0x9d, parsePOPF),-     (0x9e, parseGeneric SAHF OPNONE),-     (0x9f, parseGeneric LAHF OPNONE),--     (0xa0, parseMOVImm),-     (0xa1, parseMOVImm),-     (0xa2, parseMOVImm),-     (0xa3, parseMOVImm),-     (0xa4, parseMOVS),-     (0xa5, parseMOVS),-     (0xa6, parseCMPS),-     (0xa7, parseCMPS),-     (0xa8, parseTESTImm),-     (0xa9, parseTESTImm),-     (0xaa, parseSTOS),-     (0xab, parseSTOS),-     (0xac, parseLODS),-     (0xad, parseLODS),-     (0xae, parseSCAS),-     (0xaf, parseSCAS),--     (0xb0, parseMOVImmByteToByteReg),-     (0xb1, parseMOVImmByteToByteReg),-     (0xb2, parseMOVImmByteToByteReg),-     (0xb3, parseMOVImmByteToByteReg),-     (0xb4, parseMOVImmByteToByteReg),-     (0xb5, parseMOVImmByteToByteReg),-     (0xb6, parseMOVImmByteToByteReg),-     (0xb7, parseMOVImmByteToByteReg),-     (0xb8, parseMOVImmToReg),-     (0xb9, parseMOVImmToReg),-     (0xba, parseMOVImmToReg),-     (0xbb, parseMOVImmToReg),-     (0xbc, parseMOVImmToReg),-     (0xbd, parseMOVImmToReg),-     (0xbe, parseMOVImmToReg),-     (0xbf, parseMOVImmToReg),--     (0xc0, parseGrp2),-     (0xc1, parseGrp2),-     (0xc2, parseRETN),-     (0xc3, parseRETN),-     (0xc4, invalidIn64BitMode (parseLoadSegmentRegister LES)),-     (0xc5, invalidIn64BitMode (parseLoadSegmentRegister LDS)),-     (0xc6, parseGrp11),-     (0xc7, parseGrp11),-     (0xc8, parseENTER),-     (0xc9, parseGeneric LEAVE OPNONE),-     (0xca, parseGenericIw RETF),-     (0xcb, parseGeneric RETF OPNONE),-     (0xcc, parseGeneric INT3 OPNONE),-     (0xcd, parseGenericIb INT),-     (0xce, parseGeneric INTO OPNONE),-     (0xcf, parseGeneric IRET OPNONE),--     (0xd0, parseGrp2),-     (0xd1, parseGrp2),-     (0xd2, parseGrp2),-     (0xd3, parseGrp2),-     (0xd4, parseGenericIb AAM),-     (0xd5, parseGenericIb AAD),-     (0xd6, parseReserved), -- reserved-     (0xd7, parseGeneric XLAT OPNONE),-     (0xd8, parseESC),-     (0xd9, parseESC),-     (0xda, parseESC),-     (0xdb, parseESC),-     (0xdc, parseESC),-     (0xdd, parseESC),-     (0xde, parseESC),-     (0xdf, parseESC),--     (0xe0, parseGenericJb LOOPNE),-     (0xe1, parseGenericJb LOOPE),-     (0xe2, parseGenericJb LOOP),-     (0xe3, parseGenericJb JCXZ), -- depends on bit mode-     (0xe4, parseINImm),-     (0xe5, parseINImm),-     (0xe6, parseOUTImm),-     (0xe7, parseOUTImm),-     (0xe8, parseGenericJz CALL),-     (0xe9, parseGenericJz JMP),-     (0xea, parseJMPF),-     (0xeb, parseGenericJb JMP),-     (0xec, parseIN),-     (0xed, parseIN),-     (0xee, parseOUT),-     (0xef, parseOUT),--     (0xf0, parseInvalidPrefix), -- LOCK prefix-     (0xf1, parseReserved), -- reserved-     (0xf2, parseInvalidPrefix), -- REPNE prefix-     (0xf3, parseInvalidPrefix), -- REP/REPQ prefix-     (0xf4, parseGeneric HLT OPNONE),-     (0xf5, parseGeneric CMC OPNONE),-     (0xf6, parseGrp3),-     (0xf7, parseGrp3),-     (0xf8, parseGeneric CLC OPNONE),-     (0xf9, parseGeneric STC OPNONE),-     (0xfa, parseGeneric CLI OPNONE),-     (0xfb, parseGeneric STI OPNONE),-     (0xfc, parseGeneric CLD OPNONE),-     (0xfd, parseGeneric STD OPNONE),-     (0xfe, parseGrp4),-     (0xff, parseGrp5)--     ]--parseInvalidPrefix b = do-  return $ Bad b "invalid prefix"--parseInvalidOpcode b = do-  return $ Bad b "invalid opcode"--parseReserved b = do-  return $ Bad b "reserved opcode"--parseUndefined name b = do-  return $ Bad b ("undefined opcode: " ++ show name)--parseUnimplemented b = do-  return $ Bad b "not implemented yet"--invalidIn64BitMode p b = do-  st <- getState-  if in64BitMode st-     then return $ Bad b "invalid in 64-bit mode"-     else p b--onlyIn64BitMode p b = do-  st <- getState-  if in64BitMode st-     then p b-     else return $ Bad b "only in 64-bit mode"--choose64BitMode p32 p64 b = do-  st <- getState-  if in64BitMode st-     then p64 b-     else p32 b--chooseOperandSize p16 p32 b = do-  st <- getState-  case operandBitMode st of-    BIT16 -> p16 b-    BIT32 -> p32 b--chooseAddressSize p16 p32 b = do-  st <- getState-  case addressBitMode st of-    BIT16 -> p16 b-    BIT32 -> p32 b--parseModRM = do-  b <- anyWord8-  parseModRM' b-parseModRM' b = do-  return (b `shiftR` 6, (b `shiftR` 3) .&. 7, (b .&. 7))--parseSIB = do-  b <- anyWord8-  parseSIB' b-parseSIB' b = do-  return (b `shiftR` 6, (b `shiftR` 3) .&. 7, (b .&. 7))--scaleToFactor 0 = 1-scaleToFactor 1 = 2-scaleToFactor 2 = 4-scaleToFactor 3 = 8---parseAddress32 :: InstrOperandSize ->-		  Word8Parser (Operand, Operand, Word8, Word8, Word8)-parseAddress32 s = do-  b <- anyWord8-  parseAddress32' s b--parseAddress32' :: InstrOperandSize -> -    Word8 ->-    Word8Parser (Operand, Operand, Word8, Word8, Word8)-parseAddress32' opsize modrm = do-  (mod, reg_opc, rm) <- parseModRM' modrm-  st <- getState-  let opregnames = if in64BitMode st && hasREX rex_W st-                     then regnames64-       	      else case operandBitMode st of -			BIT16 -> regnames16-       			BIT32 -> regnames32-  let addregnames = if in64BitMode st && hasREX rex_R st-                      then regnames64-       	       else case addressBitMode st of -			BIT16 -> regnames16-       			BIT32 -> regnames32-  case mod of-    0 -> case rm of-            4 -> do -	     (s, i, b) <- parseSIB-       	     case (i, b) of-               (4, 5) -> do-                           disp <- anyWord32-                           return (OpAddr (fromIntegral disp) opsize,-                                          OpReg (opregnames !! fromIntegral reg_opc)-                                                (fromIntegral reg_opc),-                                          mod, reg_opc, rm)-               (_, 5) -> do-                           disp <- anyWord32-                           return (OpIndexDisp (addregnames !! fromIntegral i)-                                               (scaleToFactor s)-                                               (fromIntegral disp)-                                               opsize,-                                   OpReg (opregnames !! fromIntegral reg_opc)-                                         (fromIntegral reg_opc),-                                   mod, reg_opc, rm)-       	       (4, _) -> return (OpInd (addregnames !! fromIntegral b) opsize,-       	                   OpReg (opregnames !! fromIntegral reg_opc)-			     (fromIntegral reg_opc),-       		           mod, reg_opc, rm)-       	       (_ ,_) -> return (OpBaseIndex -       		              (addregnames !! fromIntegral b)-       	                      (addregnames !! fromIntegral i)-       		              (scaleToFactor (fromIntegral s))-			      opsize,-       		            OpReg (opregnames !! fromIntegral reg_opc)-			      (fromIntegral reg_opc),-       	                    mod, reg_opc, rm)-            5 -> do -	     disp <- anyWord32-       	     return (OpAddr disp opsize, -       	             OpReg (opregnames !! fromIntegral reg_opc)-		       (fromIntegral reg_opc),-       	             mod, reg_opc, rm)-            _ -> return (OpInd (addregnames !! fromIntegral rm) opsize, -       	          OpReg (opregnames !! fromIntegral reg_opc)-			(fromIntegral reg_opc),-       	          mod, reg_opc, rm)-    1 -> case rm of-            4 -> do -	     (s, i, b) <- parseSIB-	     disp <- anyInt8-       	     case i of-       	       4 -> return (OpIndDisp-       		            (addregnames !! fromIntegral b) -       		            (fromIntegral disp) opsize,-       	                    OpReg (opregnames !! fromIntegral reg_opc)-			      (fromIntegral reg_opc),-       		            mod, reg_opc, rm)-       	       _ -> return (OpBaseIndexDisp-       		            (addregnames !! fromIntegral b)-       		            (addregnames !! fromIntegral i)-       		            (scaleToFactor (fromIntegral s))-       		            (fromIntegral disp)-			    opsize,-       		            OpReg (opregnames !! fromIntegral reg_opc)-			      (fromIntegral reg_opc),-       	                    mod, reg_opc, rm)-            _ -> do disp <- anyInt8-                    return (OpIndDisp-       			    (addregnames !! fromIntegral rm) -       			    (fromIntegral disp)-			    opsize,-       			    OpReg (opregnames !! fromIntegral reg_opc)-			      (fromIntegral reg_opc),-                            mod, reg_opc, rm)-    2 -> case rm of-            4 -> do -	     (s, i, b) <- parseSIB-	     disp <- anyInt32-             case i of-       	       4 -> return (OpIndDisp-       		            (addregnames !! fromIntegral b)-       		            (fromIntegral disp)-			    opsize,-       		            OpReg (opregnames !! fromIntegral reg_opc)-			      (fromIntegral reg_opc),-       		            mod, reg_opc, rm)-       	       _ -> return (OpBaseIndexDisp-       		            (addregnames !! fromIntegral b)-       		            (addregnames !! fromIntegral i)-       		            (scaleToFactor (fromIntegral s))-       		            (fromIntegral disp)-			    opsize,-       		            OpReg (opregnames !! fromIntegral reg_opc)-			      (fromIntegral reg_opc),-       	                    mod, reg_opc, rm)-            _ -> do -	     disp <- anyInt32-       	     return (OpIndDisp-       	             (addregnames !! fromIntegral rm)-       	             (fromIntegral disp)-		     opsize,-       	             OpReg (opregnames !! fromIntegral reg_opc)-		       (fromIntegral reg_opc),-       	             mod, reg_opc, rm)-    3 -> return (OpReg (opregnames !! fromIntegral rm)-		   (fromIntegral rm),-                  OpReg (opregnames !! fromIntegral reg_opc)-		    (fromIntegral reg_opc),-                 mod, reg_opc, rm)--parseALU :: Opcode -> Word8 -> Word8Parser Instr-parseALU op b = do-    opsize <- instrOperandSize-    case b .&. 0x07 of-      0 -> do (op1, op2, mod, reg, rm) <- parseAddress32 opsize-              return $ Instr op OP8 [op1,-       	           (OpReg (regnames8 !! fromIntegral reg)) (fromIntegral reg)]-      1 -> do (op1, op2, mod, reg, rm) <- parseAddress32 opsize-              return $ Instr op opsize [op1, op2]-      2 -> do (op1, op2, mod, reg, rm) <- parseAddress32 opsize-              return $ Instr op OP8 -       	           [(OpReg (regnames8 !! fromIntegral reg))-		       (fromIntegral reg), op1]-      3 -> do (op1, op2, mod, reg, rm) <- parseAddress32 opsize-              return $ Instr op opsize [op2, op1]-      4 -> do b <- anyWord8-              return $ Instr op OP8 [(OpReg "al" 0), (OpImm (fromIntegral b))]-      5 -> do b <- anyWordZ-              rn <- registerName 0-              return $ Instr op opsize [(OpReg rn 0), (OpImm b)]-      _ -> return $ Bad b "no ALU opcode (internal error)"-    --parsePUSHSeg :: String -> Word8 -> Word8Parser Instr-parsePUSHSeg r _ = do-     return $ Instr PUSH OP16 [(OpReg r 0)] -- FIXME: register number--parsePOPSeg :: String -> Word8 -> Word8Parser Instr-parsePOPSeg r _ = do-     return $ Instr POP OP16 [(OpReg r 0)] -- FIXME: register number--parseGenericGvEw name b = do-  (op1, op2, mod, reg, rm) <- parseAddress32 OP16-  case op1 of-    OpReg _ num -> return $ Instr name OP16 [op2, -					       OpReg (regnames16 !! num) num]-    _ -> return $ Instr name OP8 [op2, op1]--parseGenericGvEb name b = do-  (op1, op2, mod, reg, rm) <- parseAddress32 OP8-  case op1 of-    OpReg _ num -> return $ Instr name OP8 [op2, -					       OpReg (regnames8 !! num) num]-    _ -> return $ Instr name OP8 [op2, op1]--parseGenericGvEv name b = do-  opsize <- instrOperandSize-  (op1, op2, mod, reg, rm) <- parseAddress32 opsize-  return $ Instr name opsize [op2, op1]--parseGenericEvGv name b = do-  opsize <- instrOperandSize-  (op1, op2, mod, reg, rm) <- parseAddress32 opsize-  return $ Instr name opsize [op1, op2]--parseGenericEbGb name b = do-  (op1, op2, mod, reg, rm) <- parseAddress32 OP8-  return $ Instr name OP8 [op1, (OpReg (regnames8 !! fromIntegral reg)-				(fromIntegral reg))]--parseGenericEv name b = do-  opsize <- instrOperandSize-  (op1, op2, mod, _, rm) <- parseAddress32 opsize-  return $ Instr name opsize [op1]--twoByteOpCodeMap = -    [(0x00, parseGrp6),-     (0x01, parseGrp7),-     (0x02, parseGenericGvEw LAR),-     (0x03, parseGenericGvEw LSL),-     (0x04, parseReserved),-     (0x05, onlyIn64BitMode (parseGeneric SYSCALL OPNONE)),-     (0x06, parseGeneric CLTS OPNONE),-     (0x07, onlyIn64BitMode (parseGeneric SYSCALL OPNONE)),-     (0x08, parseGeneric INVD OPNONE),-     (0x09, parseGeneric WBINVD OPNONE),-     (0x0a, parseReserved),-     (0x0b, parseUndefined UD2),-     (0x0c, parseReserved),-     (0x0d, parseGenericEv NOP),-     (0x0e, parseReserved),-     (0x0f, parseReserved),--     (0x10, parseMOVUPS),-     (0x11, parseMOVUPS),-     (0x12, parseMOVLPS),-     (0x13, parseMOVLPS),-     (0x14, parseUNPCKLPS),-     (0x15, parseUNPCKHPS),-     (0x16, parseMOVHPS),-     (0x17, parseMOVHPS),-     (0x18, parseGrp16),-     (0x19, parseReserved),-     (0x1a, parseReserved),-     (0x1b, parseReserved),-     (0x1c, parseReserved),-     (0x1d, parseReserved),-     (0x1e, parseReserved),-     (0x1f, parseGenericEv NOP),--     (0x20, parseMOVCtrlDebug),-     (0x21, parseMOVCtrlDebug),-     (0x22, parseMOVCtrlDebug),-     (0x23, parseMOVCtrlDebug),-     (0x24, parseReserved),-     (0x25, parseReserved),-     (0x26, parseReserved),-     (0x27, parseReserved),-     (0x28, parseMOVAPS),-     (0x29, parseMOVAPS),-     (0x2a, parseCVTI2PS),-     (0x2b, parseMOVNTPS),-     (0x2c, parseCVTTPS2PI),-     (0x2d, parseCVTPS2PI),-     (0x2e, parseUCOMISS),-     (0x2f, parseCOMISS),--     (0x30, parseGeneric WRMSR OPNONE),-     (0x31, parseGeneric RDTSC OPNONE),-     (0x32, parseGeneric RDMSR OPNONE),-     (0x33, parseGeneric RDPMC OPNONE),-     (0x34, parseGeneric SYSENTER OPNONE),-     (0x35, parseGeneric SYSEXIT OPNONE),-     (0x36, parseReserved),-     (0x37, parseReserved),-     (0x38, parseReserved),-     (0x39, parseReserved),-     (0x3a, parseReserved),-     (0x3b, parseReserved),-     (0x3c, parseReserved),-     (0x3d, parseReserved),-     (0x3e, parseReserved),-     (0x3f, parseReserved),--     (0x40, parseCMOVcc),-     (0x41, parseCMOVcc),-     (0x42, parseCMOVcc),-     (0x43, parseCMOVcc),-     (0x44, parseCMOVcc),-     (0x45, parseCMOVcc),-     (0x46, parseCMOVcc),-     (0x47, parseCMOVcc),-     (0x48, parseCMOVcc),-     (0x49, parseCMOVcc),-     (0x4a, parseCMOVcc),-     (0x4b, parseCMOVcc),-     (0x4c, parseCMOVcc),-     (0x4d, parseCMOVcc),-     (0x4e, parseCMOVcc),-     (0x4f, parseCMOVcc),--     (0x50, parseMOVSKPS),-     (0x51, parseSQRTPS),-     (0x52, parseRSQRTPS),-     (0x53, parseRCPPS),-     (0x54, parseANDPS),-     (0x55, parseANDNPS),-     (0x56, parseORPS),-     (0x57, parseXORPS),-     (0x58, parseADDPS),-     (0x59, parseMULPS),-     (0x5a, parseCVTPS2PD),-     (0x5b, parseCVTDQ2PS),-     (0x5c, parseSUBPS),-     (0x5d, parseMINPS),-     (0x5e, parseDIVPS),-     (0x5f, parseMAXPS),--     (0x60, parsePUNPCKLBW),-     (0x61, parsePUNPCKLWD),-     (0x62, parsePUNPCKLDQ),-     (0x63, parsePACKSSWB),-     (0x64, parsePCMPGTB),-     (0x65, parsePCMPGTW),-     (0x66, parsePCMPGTD),-     (0x67, parsePACKUSWB),-     (0x68, parsePUNPCKHBW),-     (0x69, parsePUNPCKHWD),-     (0x6a, parsePUNPCKHDQ),-     (0x6b, parsePACKSSDW),-     (0x6c, parsePUNPCKLQDQ),-     (0x6d, parsePUNPCKHQDQ),-     (0x6e, parseMOVD_Q),-     (0x6f, parseMOVQ),--     (0x70, parsePSHUFW),-     (0x71, parseGrp12),-     (0x72, parseGrp13),-     (0x73, parseGrp14),-     (0x74, parsePCMPEQB),-     (0x75, parsePCMPEQW),-     (0x76, parsePCMPEQD),-     (0x77, parseGeneric EMMS OPNONE),-     (0x78, parseVMREAD),-     (0x79, parseVMWRITE),-     (0x7a, parseReserved),-     (0x7b, parseReserved),-     (0x7c, parseHADDPS),-     (0x7d, parseHSUBPS),-     (0x7e, parseMOVD_Q),-     (0x7f, parseMOVQ),--     (0x80, parseJccLong),-     (0x81, parseJccLong),-     (0x82, parseJccLong),-     (0x83, parseJccLong),-     (0x84, parseJccLong),-     (0x85, parseJccLong),-     (0x86, parseJccLong),-     (0x87, parseJccLong),-     (0x88, parseJccLong),-     (0x89, parseJccLong),-     (0x8a, parseJccLong),-     (0x8b, parseJccLong),-     (0x8c, parseJccLong),-     (0x8d, parseJccLong),-     (0x8e, parseJccLong),-     (0x8f, parseJccLong),--     (0x90, parseSETcc),-     (0x91, parseSETcc),-     (0x92, parseSETcc),-     (0x93, parseSETcc),-     (0x94, parseSETcc),-     (0x95, parseSETcc),-     (0x96, parseSETcc),-     (0x97, parseSETcc),-     (0x98, parseSETcc),-     (0x99, parseSETcc),-     (0x9a, parseSETcc),-     (0x9b, parseSETcc),-     (0x9c, parseSETcc),-     (0x9d, parseSETcc),-     (0x9e, parseSETcc),-     (0x9f, parseSETcc),--     (0xa0, parsePUSHSeg "fs"),-     (0xa1, parsePOPSeg "fs"),-     (0xa2, parseGeneric CPUID OPNONE),-     (0xa3, parseGenericEvGv BT),-     (0xa4, parseSHLD),-     (0xa5, parseSHLD),-     (0xa6, parseReserved),-     (0xa7, parseReserved),-     (0xa8, parsePUSHSeg "gs"),-     (0xa9, parsePOPSeg "gs"),-     (0xaa, parseGeneric RSM OPNONE),-     (0xab, parseGenericEvGv BTS),-     (0xac, parseSHRD),-     (0xad, parseSHRD),-     (0xae, parseGrp15),-     (0xaf, parseGenericGvEv IMUL),--     (0xb0, parseGenericEbGb CMPXCHG),-     (0xb1, parseGenericEvGv CMPXCHG),-     (0xb2, parseLoadSegmentRegister LSS),-     (0xb3, parseGenericEvGv BTR),-     (0xb4, parseLoadSegmentRegister LFS),-     (0xb5, parseLoadSegmentRegister LGS),-     (0xb6, parseGenericGvEb MOVZXB),-     (0xb7, parseGenericGvEw MOVZXW),-     (0xb8, parseReserved),-     (0xb9, parseGrp10),-     (0xba, parseGrp8),-     (0xbb, parseGenericEvGv BTC),-     (0xbc, parseGenericGvEv BSF),-     (0xbd, parseGenericGvEv BSR),-     (0xbe, parseGenericGvEb MOVSXB),-     (0xbf, parseGenericGvEw MOVSXW),--     (0xc0, parseGenericEbGb XADD),-     (0xc1, parseGenericEvGv XADD),-     (0xc2, parseCMPPS),-     (0xc3, parseMOVNTI),-     (0xc4, parsePINSRW),-     (0xc5, parsePEXTRW),-     (0xc6, parseSHUFPS),-     (0xc7, parseGrp9),-     (0xc8, parseBSWAP),-     (0xc9, parseBSWAP),-     (0xca, parseBSWAP),-     (0xcb, parseBSWAP),-     (0xcc, parseBSWAP),-     (0xcd, parseBSWAP),-     (0xce, parseBSWAP),-     (0xcf, parseBSWAP),--     (0xd0, parseADDSUBPS),-     (0xd1, parsePSRLW),-     (0xd2, parsePSRLD),-     (0xd3, parsePSRLQ),-     (0xd4, parsePADDQ),-     (0xd5, parsePMULLW),-     (0xd6, parseMOVQ),-     (0xd7, parsePMOVMSKB),-     (0xd8, parsePSUBUSB),-     (0xd9, parsePSUBUSW),-     (0xda, parsePMINUB),-     (0xdb, parsePAND),-     (0xdc, parsePADDUSB),-     (0xdd, parsePADDUSW),-     (0xde, parsePMAXUB),-     (0xdf, parsePANDN),--     (0xe0, parsePAVGB),-     (0xe1, parsePSRAW),-     (0xe2, parsePSRAD),-     (0xe3, parsePAVGW),-     (0xe4, parsePMULHUW),-     (0xe5, parsePMULHW),-     (0xe6, parseCVTPD2DQ),-     (0xe7, parseMOVNTQ),-     (0xe8, parsePSUBSB),-     (0xe9, parsePSUBSQ),-     (0xea, parsePMINSW),-     (0xeb, parsePOR),-     (0xec, parsePADDSB),-     (0xed, parsePADDSW),-     (0xee, parsePMAXSW),-     (0xef, parsePXOR),--     (0xf0, parseLDDQU),-     (0xf1, parsePSLLW),-     (0xf2, parsePSLLD),-     (0xf3, parsePSLLQ),-     (0xf4, parsePMULUDQ),-     (0xf5, parsePMADDWD),-     (0xf6, parsePSADBW),-     (0xf7, parseMASKMOVQ),-     (0xf8, parsePSUBB),-     (0xf9, parsePSUBW),-     (0xfa, parsePSUBD),-     (0xfb, parsePSUBQ),-     (0xfc, parsePADDB),-     (0xfd, parsePADDW),-     (0xfe, parsePADDD),-     (0xff, parseReserved)-     ]--twoByteEscape :: Word8 -> Word8Parser Instr-twoByteEscape b1 = do-  b <- anyWord8-  case lookup b twoByteOpCodeMap of-    Just p -> p b-    Nothing -> return $ Bad b "invalid two-byte opcode"--parseGeneric name opsize _ = do-    return (Instr name opsize [])-parseGenericIb name b = do-    b <-  anyWord8-    return $ Instr name OP8 [OpImm (fromIntegral b)]-parseGenericIw name _ = do-    w <- anyWord16-    pos <- getPosition-    return $ Instr name OP16 [OpImm (fromIntegral w)]-parseGenericJb name _ = do-    b <- anyInt8-    pos <- getPosition-    st <- getState-    return $ Instr name OPNONE -        [OpAddr (fromIntegral ((fromIntegral b + sourceColumn pos - 1)) +-       		(startAddr st)) OPNONE]-parseGenericJz name _ = do-    b <- anyIntZ-    pos <- getPosition-    st <- getState-    return $ Instr name OPNONE -        [OpAddr (fromIntegral ((fromIntegral b + sourceColumn pos - 1)) +-       	       (startAddr st)) OPNONE]--parseINC b = do-  opsize <- instrOperandSize-  let reg = b .&. 0x0f-  rn <- registerName (fromIntegral reg)-  return $ Instr INC opsize [OpReg rn (fromIntegral reg)]--parseDEC b = do-  opsize <- instrOperandSize-  let reg = (b .&. 0x0f) - 8-  rn <- registerName (fromIntegral reg)-  return $ Instr DEC opsize [OpReg rn (fromIntegral reg)]--parsePUSH b = -    let reg = b .&. 0x0f in do-      st <- getState-      rn <- registerName (fromIntegral reg)-      opsize <- instrOperandSize-      if hasREX rex_R st-         then return $ Instr PUSH opsize [OpReg ("r" ++ show (reg + 8))-					   (fromIntegral reg)]-          else return $ Instr PUSH opsize [OpReg rn-					    (fromIntegral reg)]--parsePOP b = -    let reg = (b .&. 0x0f) - 8 in do-      st <- getState-      rn <- registerName (fromIntegral reg)-      opsize <- instrOperandSize-      if hasREX rex_R st-         then return $ Instr POP opsize [OpReg ("r" ++ show (reg + 8))-					 (fromIntegral reg)]-          else return $ Instr POP opsize [OpReg rn (fromIntegral reg)]--parsePUSHA = do-  chooseOperandSize-    (\ _ -> return $ Instr PUSHA OPNONE [])-    (\ _ -> return $ Instr PUSHAD OPNONE [])-parsePOPA = do-  chooseOperandSize-    (\ _ -> return $ Instr POPA OPNONE [])-    (\ _ -> return $ Instr POPAD OPNONE [])--parseBOUND b = do-  (op1, op2, mod, reg, rm) <- parseAddress32 OPNONE-  return $ Instr BOUND OPNONE [op2, op1]-  -parseARPL b = do-  (op1, op2, mod, reg, rm) <- parseAddress32 OP16-  let rn = regnames16 !! fromIntegral reg-  return $ Instr ARPL OPNONE [op1, (OpReg rn (fromIntegral reg))]-     -parseMOVSXD b = do-  (op1, op2, mod, reg, rm) <- parseAddress32 OPNONE-  return $ Instr MOVSXD OPNONE [op2, op1]--parsePUSHImm 0x68 = do-  w <- anyWordZ-  opsize <- instrOperandSize-  return $ Instr PUSH opsize [OpImm w]-parsePUSHImm 0x6a = do-  w <- anyWord8-  opsize <- instrOperandSize-  return $ Instr PUSH opsize [OpImm (fromIntegral w)]--parseIMUL 0x69 = do-  opsize <- instrOperandSize-  (op1, op2, mod, reg, rm) <- parseAddress32 opsize-  imm <- anyWordZ-  return $ Instr IMUL opsize [op2, op1, OpImm imm]-parseIMUL 0x6b = do-  opsize <- instrOperandSize-  (op1, op2, mod, reg, rm) <- parseAddress32 opsize-  imm <- anyWord8-  return $ Instr IMUL opsize [op2, op1, OpImm (fromIntegral imm)]--parseINS 0x6c = return $ Instr INS OP8 []-parseINS b@0x6d = chooseOperandSize-                   (\ _ -> return $ Instr INS OP16 [])-                  (\ _ -> return $ Instr INS OP32 []) b--parseOUTS 0x6e = return $ Instr OUTS OP8 []-parseOUTS b@0x6f = chooseOperandSize-                     (\ _ -> return $ Instr OUTS OP16 [])-                     (\ _ -> return $ Instr OUTS OP32 []) b--parseJccShort b = do-  disp <- anyInt8-  pos <- getPosition-  st <- getState-  return $ Instr (jccname (b .&. 0xf)) OPNONE-        [OpAddr (fromIntegral (fromIntegral disp + sourceColumn pos - 1) +-                (startAddr st)) OPNONE]--parseTEST 0x84 = do-  (op1, op2, mod, reg, rm) <- parseAddress32 OP8-  return $ Instr TEST OP8 [op1, OpReg (regnames8 !! fromIntegral reg)-			  (fromIntegral reg)]-parseTEST 0x85 = do-  opsize <- instrOperandSize-  (op1, op2, mod, reg, rm) <- parseAddress32 opsize-  return $ Instr TEST opsize [op1, op2]--parseXCHG 0x86 = do-  (op1, op2, mod, reg, rm) <- parseAddress32 OP8-  return $ Instr XCHG OP8 [op1, OpReg (regnames8 !! fromIntegral reg)-			   (fromIntegral reg)]-parseXCHG 0x87 = do-  opsize <- instrOperandSize-  (op1, op2, mod, reg, rm) <- parseAddress32 opsize-  return $ Instr XCHG opsize[op1, op2]--parseMOV 0x88  = do-  (op1, op2, mod, reg, rm) <- parseAddress32 OP8-  return $ Instr MOV OP8 [op1, OpReg (regnames8 !! fromIntegral reg)-			  (fromIntegral reg)]-parseMOV 0x89  = do-  opsize <- instrOperandSize-  (op1, op2, mod, reg, rm) <- parseAddress32 opsize-  return $ Instr MOV opsize [op1, op2]-parseMOV 0x8a  = do-  (op1, op2, mod, reg, rm) <- parseAddress32 OP8-  return $ Instr MOV OP8 [OpReg (regnames8 !! fromIntegral reg) -			  (fromIntegral reg), op1]-parseMOV 0x8b  = do-  opsize <- instrOperandSize-  (op1, op2, mod, reg, rm) <- parseAddress32 opsize-  return $ Instr MOV opsize [op2, op1]-parseMOV 0x8c  = do-  (op1, op2, mod, reg, rm) <- parseAddress32 OP16-  let rn = segregnames !! (fromIntegral reg)-  return $ Instr MOV OP16 [op1, OpReg rn (fromIntegral reg)]-parseMOV 0x8e  = do-  (op1, op2, mod, reg, rm) <- parseAddress32 OP16-  let rn = segregnames !! (fromIntegral reg)-  return $ Instr MOV OP16 [OpReg rn (fromIntegral reg), op1]--parseLEA b = do-  (op1, op2, mod, reg, rm) <- parseAddress32 OPNONE-  return $ Instr LEA OPNONE [op2, op1]---parse0x90 b = do-  st <- getState-  if hasPrefix 0xf3 st-     then return $ Instr PAUSE OPNONE []-     else do st <- getState-             if in64BitMode st-                then parseXCHGReg b-       		else return $ Instr NOP OPNONE []---- FIXME: Register name handling not quite right--parseXCHGReg :: Word8 -> Word8Parser Instr-parseXCHGReg b = -    let reg = b .&. 0x0f in do-      st <- getState-      if hasREX rex_R st-         then return $ Instr XCHG OP64 [OpReg "rax" 0, -       					OpReg ("r" ++ show (reg + 8))-					(fromIntegral reg)]-         else do rn <- registerName (fromIntegral reg)-       		 return $ Instr XCHG OP64 [OpReg "rax" 0,-					   OpReg rn (fromIntegral reg)]--parseCBW_CWDE_CDQE b = do-  st <- getState-  if in64BitMode st-     then if hasREX rex_W st-             then return $ Instr CDQE OPNONE []-              else return $ Instr CWDE OPNONE []-     else chooseOperandSize-            (\ _ -> return $ Instr CBW OPNONE [])-            (\ _ -> return $ Instr CWDE OPNONE []) b--parseCWD_CDQ_CQO b = do-  st <- getState-  if in64BitMode st-     then if hasREX rex_W st-             then return $ Instr CDQE OPNONE []-              else return $ Instr CDQ OPNONE []-     else chooseOperandSize-            (\ _ -> return $ Instr CWD OPNONE [])-            (\ _ -> return $ Instr CDQ OPNONE []) b--parseCALLF b = do-    w <- anyWord32-    s <- anyWord16-    return $ Instr CALLF OPNONE [OpImm (fromIntegral w),-       		           OpImm (fromIntegral s)]---- FIXME: Check default/operand sizes.--parsePUSHF b = do-  st <- getState-  if in64BitMode st-     then chooseOperandSize-             (\ _ -> return $ Instr PUSHF OPNONE [])-             (\ _ -> return $ Instr PUSHFQ OPNONE []) b-     else chooseOperandSize-             (\ _ -> return $ Instr PUSHF OPNONE [])-             (\ _ -> return $ Instr PUSHFD OPNONE []) b--parsePOPF b = do-  st <- getState-  if in64BitMode st-     then chooseOperandSize-             (\ _ -> return $ Instr POPF OPNONE [])-             (\ _ -> return $ Instr POPFQ OPNONE []) b-     else chooseOperandSize-             (\ _ -> return $ Instr POPF OPNONE [])-             (\ _ -> return $ Instr POPFD OPNONE []) b--parseJMPF b = do-    w <- anyWord32-    return $ Instr JMPF OPNONE [OpImm w]--parseMOVImm b@0xa0 = do-  chooseAddressSize-    (\ _ -> do w <- anyWord16-               return $ Instr MOV OP8 [OpReg "al" 0, OpImm (fromIntegral w)])-    (\ _ -> do w <- anyWord32-               return $ Instr MOV OP8 [OpReg "al" 0, OpImm w]) b-parseMOVImm b@0xa1 = do-  opsize <- instrOperandSize-  reg <- registerName 0-  chooseAddressSize-    (\ _ -> do w <- anyWord16-               return $ Instr MOV opsize [OpReg reg 0, OpImm (fromIntegral w)])-    (\ _ -> do w <- anyWord32-       	       return $ Instr MOV opsize [OpReg reg 0, OpImm w]) b-parseMOVImm b@0xa2 = do-  chooseAddressSize-    (\ _ -> do w <- anyWord16-       	       return $ Instr MOV OP8 [OpImm (fromIntegral w), OpReg "al" 0])-    (\ _ -> do w <- anyWord32-       	       return $ Instr MOV OP8 [OpImm w, OpReg "al" 0]) b-parseMOVImm b@0xa3 = do-  opsize <- instrOperandSize-  reg <- registerName 0-  chooseAddressSize-    (\ _ -> do w <- anyWord16-       	       return $ Instr MOV opsize [OpImm (fromIntegral w), OpReg reg 0])-    (\ _ -> do w <- anyWord32-               return $ Instr MOV opsize [OpImm w, OpReg reg 0]) b--parseMOVS 0xa4 = return $ Instr MOVS OP8 []-parseMOVS b@0xa5 = do-  st <- getState-  opsize <- instrOperandSize-  return $ Instr MOVS opsize []--parseCMPS 0xa6 = return $ Instr CMPS OP8 []-parseCMPS 0xa7 = do-  st <- getState-  opsize <- instrOperandSize-  return $ Instr CMPS opsize []--parseTESTImm 0xa8 = do-  imm <- anyWord8-  return $ Instr TEST OP8 [OpReg "al" 0, OpImm (fromIntegral imm)]-parseTESTImm 0xa9 = do-  imm <- anyWordZ-  rn <- registerName 0-  opsize <- instrOperandSize-  return $ Instr TEST opsize [OpReg rn 0, OpImm imm]-  --parseSTOS 0xaa = return $ Instr STOS OP8 []-parseSTOS b@0xab = do-  st <- getState-  opsize <- instrOperandSize-  if in64BitMode st-     then if hasREX rex_W st-             then return $ Instr STOS opsize []-              else chooseOperandSize-                    (\ _ -> return $ Instr STOS opsize [])-                    (\ _ -> return $ Instr STOS opsize []) b-     else chooseOperandSize-            (\ _ -> return $ Instr STOS opsize [])-            (\ _ -> return $ Instr STOS opsize []) b--parseLODS 0xac = return $ Instr LODS OP8 []-parseLODS b@0xad = do-  st <- getState-  opsize <- instrOperandSize-  if in64BitMode st-     then if hasREX rex_W st-             then return $ Instr LODS opsize []-              else chooseOperandSize-                    (\ _ -> return $ Instr LODS opsize [])-                    (\ _ -> return $ Instr LODS opsize []) b-     else chooseOperandSize-            (\ _ -> return $ Instr LODS opsize [])-            (\ _ -> return $ Instr LODS opsize []) b--parseSCAS 0xae = return $ Instr SCAS OP8 []-parseSCAS b@0xaf = do-  st <- getState-  opsize <- instrOperandSize-  if in64BitMode st-     then if hasREX rex_W st-             then return $ Instr SCAS opsize []-              else chooseOperandSize-                    (\ _ -> return $ Instr SCAS opsize [])-                    (\ _ -> return $ Instr SCAS opsize []) b-     else chooseOperandSize-            (\ _ -> return $ Instr SCAS opsize [])-            (\ _ -> return $ Instr SCAS opsize []) b--parseMOVImmByteToByteReg :: Word8 -> Word8Parser Instr-parseMOVImmByteToByteReg b = do-  let reg = b .&. 0x0f-  st <- getState-  imm <- anyWord8-  if hasREX rex_R st-     then return $ Instr MOV OP8 [OpReg ("r" ++ show reg ++ "l")-				   (fromIntegral reg),-       				  OpImm (fromIntegral imm)]-     else return $ Instr MOV OP8 [OpReg (regnames8 !! (fromIntegral reg))-				    (fromIntegral reg), -       				  OpImm (fromIntegral imm)]--parseMOVImmToReg :: Word8 -> Word8Parser Instr-parseMOVImmToReg b = do-  let reg = (b .&. 0x0f - 8)-  imm <- anyWordV-  opsize <- instrOperandSize-  rn <- registerName (fromIntegral reg)-  return $ Instr MOV opsize [OpReg rn (fromIntegral reg), -			     OpImm (fromIntegral imm)]--parseRETN 0xc2 = do-    w <- anyWord16-    return $ Instr RET OPNONE [OpImm (fromIntegral w)]-parseRETN 0xc3 = return $ Instr RET OPNONE []--parseLoadSegmentRegister opcode b = do-  (op1, op2, mod, reg, rm) <- parseAddress32 OPNONE-  return $ Instr opcode OPNONE [op2, op1]--parseENTER b = do-    w <- anyWord16-    b <- anyWord8-    return $ Instr ENTER OPNONE [OpImm (fromIntegral w), -       		           OpImm (fromIntegral b)]---- Floating-point operations.  These can probably shortened by doing some--- arithmetic/logical tricks on the opcodes, but since the instruction--- set is still quite irregular (even though much better than the integer--- ops), I haven't bothered yet.--parseESC 0xd8 = do-  modrm <- anyWord8-  let modrm' :: Word8-      modrm' = modrm - 0xc0-  if modrm <= 0xbf-     then do (op1, op2, mod, reg, rm) <- parseAddress32' OPF32 modrm-             return $ Instr (ops !! fromIntegral reg) OPF32 [op1]-     else if (modrm .&. 0x0f) < 0x8-             then return $ Instr -       	     (ops !! fromIntegral ((modrm' `shiftR` 3))) OPNONE-                    [OpFPReg 0, OpFPReg (fromIntegral (modrm .&. 0x0f))]-              else return $ Instr -       	     (ops !! fromIntegral ((modrm' `shiftR` 3))) OPNONE-                    [OpFPReg 0, OpFPReg (fromIntegral ((modrm .&. 0x0f) - 8))]- where ops = [FADD, FMUL, FCOM, FCOMP, -               FSUB, FSUBR, FDIV, FDIVR]-             -parseESC b@0xd9 = do-  modrm <- anyWord8-  let modrm' :: Word8-      modrm' = modrm - 0xc0-  if modrm <= 0xbf-     then do (op1', op2, mod, reg, rm) <- parseAddress32' OPNONE modrm-	     let op1 = case op1' of -		         OpAddr a _ -> OpAddr a  (opsizes !! fromIntegral reg)-			 op -> op-             return $ Instr (lowOps !! fromIntegral reg) -       	              (opsizes !! fromIntegral reg) [op1]-     else if (modrm < 0xd0)-             then if (modrm .&. 0x0f) < 8-                    then return $ Instr -       	          (ops !! fromIntegral ((modrm' `shiftR` 3))) OPNONE-                         [OpFPReg 0, OpFPReg (fromIntegral (modrm .&. 0x0f))]-                    else return $ Instr -       	          (ops !! fromIntegral ((modrm' `shiftR` 3))) OPNONE-                         [OpFPReg 0, OpFPReg (fromIntegral (modrm .&. 0x0f)-       			      - 8)]-              else case modrm of-       		     0xd0 -> return $ Instr FNOP OPNONE []-                     0xe0 -> return $ Instr FCHS OPNONE []-                     0xe1 -> return $ Instr FABS OPNONE []-                     0xe4 -> return $ Instr FTST OPNONE []-                     0xe5 -> return $ Instr FXAM OPNONE []-                     0xe8 -> return $ Instr FLD1 OPNONE []-                     0xe9 -> return $ Instr FLDL2T OPNONE []-                     0xea -> return $ Instr FLDL2E OPNONE []-                     0xeb -> return $ Instr FLDPI OPNONE []-                     0xec -> return $ Instr FLDLG2 OPNONE []-                     0xed -> return $ Instr FLDLN2 OPNONE []-                     0xee -> return $ Instr FLDZ OPNONE []-                     _ -> parseInvalidOpcode b- where lowOps = [FLD, InvalidOpcode, FST, FSTP, -                  FLDENV, FLDCW, FSTENV, FSTCW]-       opsizes = [OPF32, OPNONE, OPF32, OPF32,-                   OPNONE, OPNONE, OPNONE, OPNONE]-       ops = [FLD, FXCH]--parseESC 0xda = do-  modrm <- anyWord8-  let modrm' :: Word8-      modrm' = modrm - 0xc0-  if modrm <= 0xbf-     then do (op1, op2, mod, reg, rm) <- parseAddress32' OPNONE modrm-             return $ Instr (ops !! fromIntegral reg) OPNONE [op1]-     else if (modrm < 0xe0)-             then return $ Instr -       	     (ops' !! fromIntegral ((modrm' `shiftR` 3))) OPNONE-                    [OpFPReg 0, OpFPReg (fromIntegral (modrm .&. 0x0f))]-              else case modrm of-                     0xe1 -> return $ Instr FUCOMPP OPNONE []-                     _ -> parseInvalidOpcode 0xda- where ops = [FIADD, FIMUL, FICOM, FICOMP, -               FISUB, FISUBR, FIDIV, FIDIVR]-       ops' = [FCMOVB, FCMOVE, FCMOVBE, FCMOVU]--parseESC 0xdb = do-  modrm <- anyWord8-  let modrm' :: Word8-      modrm' = modrm - 0xc0-  if modrm <= 0xbf-     then do (op1', op2, mod, reg, rm) <- parseAddress32' OPNONE modrm-	     let op1 = case op1' of -		         OpAddr a _ -> OpAddr a  (opsizes !! fromIntegral reg)-			 op -> op-             return $ Instr (ops !! fromIntegral reg) -       	              (opsizes !! fromIntegral reg) [op1]-     else -      case modrm of-         0xe2 -> return $ Instr FCLEX OPNONE []-         0xe3 -> return $ Instr FINIT OPNONE []-         _ ->-           if (modrm .&. 0x0f) < 0x8-             then return $ Instr -       	     (ops' !! fromIntegral ((modrm' `shiftR` 3))) OPNONE-                    [OpFPReg 0, OpFPReg (fromIntegral (modrm .&. 0x0f))]-              else return $ Instr -       	     (ops' !! fromIntegral ((modrm' `shiftR` 3))) OPNONE-                    [OpFPReg 0, OpFPReg (fromIntegral ((modrm .&. 0x0f) - 8))]- where ops = [FILD, FISTP, FIST, FISTP, -               InvalidOpcode, FLD, InvalidOpcode, FSTP]-       opsizes = [OP32, OP32, OP32, OP32,-                   OPNONE, OPF80, OPNONE, OPF80]-       ops' = [FCMOVNB, FCMOVNE, FCMOVNBE, FCMOVNU,-                InvalidOpcode, FUCOMI, FCOMI, InvalidOpcode]--parseESC 0xdc = do-  modrm <- anyWord8-  let modrm' :: Word8-      modrm' = modrm - 0xc0-  if modrm <= 0xbf-     then do (op1, op2, mod, reg, rm) <- parseAddress32' OPNONE modrm-             return $ Instr (ops !! fromIntegral reg) OPNONE [op1]-     else-       if modrm >= 0xd0 && modrm < 0xe0-        then parseInvalidOpcode 0xdc-        else if (modrm .&. 0x0f) < 0x8-             then return $ Instr -       	     (ops !! fromIntegral ((modrm' `shiftR` 3))) OPNONE-                    [OpFPReg (fromIntegral (modrm .&. 0x0f)), OpFPReg 0]-              else return $ Instr -       	     (ops !! fromIntegral ((modrm' `shiftR` 3))) OPNONE-                    [OpFPReg (fromIntegral ((modrm .&. 0x0f) - 8)), OpFPReg 0]- where ops = [FADD, FMUL, FCOM, FCOMP, -               FSUB, FSUBR, FDIV, FDIVR]-             -parseESC 0xdd = do-  modrm <- anyWord8-  let modrm' :: Word8-      modrm' = modrm - 0xc0-  if modrm <= 0xbf-     then do (op1', op2, mod, reg, rm) <- parseAddress32' OPNONE modrm-	     let op1 = case op1' of -		         OpAddr a _ -> OpAddr a  (opsizes !! fromIntegral reg)-			 op -> op-             return $ Instr (ops !! fromIntegral reg) -       	              (opsizes !! fromIntegral reg) [op1]-     else-       if (modrm >= 0xc8) && modrm <= 0xd0 || (modrm >= 0xf0 && modrm < 0xff)-        then parseInvalidOpcode 0xdc-        else if (modrm .&. 0x0f) < 0x8-             then return $ Instr -       	     (ops' !! fromIntegral ((modrm' `shiftR` 3))) OPNONE-                    [OpFPReg (fromIntegral (modrm .&. 0x0f)), OpFPReg 0]-              else return $ Instr -       	     (ops' !! fromIntegral ((modrm' `shiftR` 3))) OPNONE-                    [OpFPReg (fromIntegral ((modrm .&. 0x0f) - 8)), OpFPReg 0]- where ops = [FLD, FISTTP, FST, FSTP, -               FRSTOR, InvalidOpcode, FSAVE, FSTSW]-       opsizes = [OPF64, OP64, OPF64, OPF64,-                   OPNONE, OPNONE, OPNONE, OP16]-       ops' = [FFREE, InvalidOpcode, FST, FSTP, -                FUCOM, FUCOMP]-             -parseESC 0xde = do-  modrm <- anyWord8-  let modrm' :: Word8-      modrm' = modrm - 0xc0-  if modrm <= 0xbf-     then do (op1, op2, mod, reg, rm) <- parseAddress32' OPNONE modrm-             return $ Instr (ops !! fromIntegral reg) OPNONE [op1]-     else-       if modrm >= 0xd0 && modrm <= 0xe0-        then case modrm of-       	 0xd9 -> return $ Instr FCOMPP OPNONE []-       	 _ -> parseInvalidOpcode 0xde-        else if (modrm .&. 0x0f) < 0x8-             then return $ Instr -       	     (ops' !! fromIntegral ((modrm' `shiftR` 3))) OPNONE-                    [OpFPReg (fromIntegral (modrm .&. 0x0f)), OpFPReg 0]-              else return $ Instr -       	     (ops' !! fromIntegral ((modrm' `shiftR` 3))) OPNONE-                    [OpFPReg (fromIntegral ((modrm .&. 0x0f) - 8)), OpFPReg 0]- where ops = [FIADD, FIMUL, FICOM, FICOMP, -               FISUB, FISUBR, FIDIV, FIDIVR]-       ops' = [FADDP, FMULP, InvalidOpcode, InvalidOpcode,-                FSUBRP, FSUBP, FDIVRP, FDIVP]-             -             -parseESC 0xdf = do-  modrm <- anyWord8-  let modrm' :: Word8-      modrm' = modrm - 0xc0-  if modrm <= 0xbf-     then do (op1, op2, mod, reg, rm) <- parseAddress32' OPNONE modrm-             return $ Instr (ops !! fromIntegral reg) OPNONE [op1]-     else-       case modrm of-           0xe0 -> return $ Instr FSTSW OPNONE [OpReg "ax" 0]-           _ -> -             if (modrm >= 0xe8 && modrm <= 0xef) ||-                (modrm >= 0xf0 && modrm <= 0xf7)-             then-             if (modrm .&. 0x0f) < 0x8-             then return $ Instr -       	     (ops' !! fromIntegral ((modrm' `shiftR` 3))) OPNONE-                    [OpFPReg (fromIntegral (modrm .&. 0x0f)), OpFPReg 0]-              else return $ Instr -       	     (ops' !! fromIntegral ((modrm' `shiftR` 3))) OPNONE-                    [OpFPReg (fromIntegral ((modrm .&. 0x0f) - 8)), OpFPReg 0]-             else parseInvalidOpcode 0xdf- where ops = [FILD, FISTPP, FIST, FISTP, -               FBLD, FILD, FBSTP, FISTP]-       ops' = [InvalidOpcode, InvalidOpcode, InvalidOpcode, InvalidOpcode,-                InvalidOpcode, FUCOMIP, FCOMIP, InvalidOpcode]--parseINImm 0xe4 = do-    b <- anyWord8-    return $ Instr IN OP8 [OpReg "al" 0, OpImm (fromIntegral b)]-parseINImm 0xe5 = do-    b <- anyWord8-    rn <- registerName 0-    opsize <- instrOperandSize-    return $ Instr IN opsize [OpReg rn 0, OpImm (fromIntegral b)]-parseOUTImm 0xe6 = do-    b <- anyWord8-    return $ Instr OUT OP8 [OpImm (fromIntegral b), OpReg "al" 0]-parseOUTImm 0xe7 = do-    b <- anyWord8-    rn <- registerName 0-    opsize <- instrOperandSize-    return $ Instr OUT opsize [OpImm (fromIntegral b), OpReg rn 0]--parseIN 0xec = do-    return $ Instr IN OP8 [OpReg "al" 0, OpReg "dx" 2]-parseIN 0xed = do-    rn <- registerName 0-    opsize <- instrOperandSize-    return $ Instr IN opsize [OpReg rn 0, OpReg "dx" 2]-parseOUT 0xee = do-    return $ Instr OUT OP8 [OpReg "dx" 2, OpReg "al" 0]-parseOUT 0xef = do-    rn <- registerName 0-    opsize <- instrOperandSize-    return $ Instr OUT opsize [OpReg "dx" 2, OpReg rn 0]---- Return the name of the register encoded with R.  Take 64-bit mode and--- possible REX and operand-size prefixes into account.--registerName r = do-    st <- getState-    if in64BitMode st && hasREX rex_R st-       then return $ "r" ++ show (r + 8)-       else case operandBitMode st of-              BIT16 -> return $ regnames16 !! r-              BIT32 -> return $ regnames32 !! r--instrOperandSize = do-    st <- getState-    if in64BitMode st && hasREX rex_W st-       then return $ OP64-       else case operandBitMode st of-              BIT16 -> return OP16-              BIT32 -> return OP32--regnames8 = ["al", "cl", "dl", "bl", "ah", "ch", "dh", "bh"]-regnames16 = ["ax", "cx", "dx", "bx", "sp", "bp", "si", "di"]-regnames32 = ["eax", "ecx", "edx", "ebx", "esp", "ebp", "esi", "edi"]-regnames64 = ["rax", "rcx", "rdx", "rbx", "rsp", "rbp", "rsi", "rdi"]-segregnames = ["es", "cs", "ss", "ds", "fs", "gs", "<invalid>", "<invalid>"]-mmxregs = ["mm0", "mm1", "mm2", "mm3", "mm4", "mm5", "mm6", "mm7"]-xmmregs = ["xmm0", "xmm1", "xmm2", "xmm3", "xmm4", "xmm5", "xmm6", "xmm7"]--jccname 0 = JO-jccname 1 = JNO-jccname 2 = JB-jccname 3 = JNB-jccname 4 = JE-jccname 5 = JNE-jccname 6 = JBE-jccname 7 = JA-jccname 8 = JS-jccname 9 = JNS-jccname 10 = JP-jccname 11 = JNP-jccname 12 = JL-jccname 13 = JGE-jccname 14 = JLE-jccname 15 = JG--setccname 0 = SETO-setccname 1 = SETNO-setccname 2 = SETB-setccname 3 = SETNB-setccname 4 = SETE-setccname 5 = SETNE-setccname 6 = SETBE-setccname 7 = SETA-setccname 8 = SETS-setccname 9 = SETNS-setccname 10 = SETP-setccname 11 = SETNP-setccname 12 = SETL-setccname 13 = SETGE-setccname 14 = SETLE-setccname 15 = SETG--cmovccname 0 = CMOVO-cmovccname 1 = CMOVNO-cmovccname 2 = CMOVB-cmovccname 3 = CMOVNB-cmovccname 4 = CMOVE-cmovccname 5 = CMOVNE-cmovccname 6 = CMOVBE-cmovccname 7 = CMOVA-cmovccname 8 = CMOVS-cmovccname 9 = CMOVNS-cmovccname 10 = CMOVP-cmovccname 11 = CMOVNP-cmovccname 12 = CMOVL-cmovccname 13 = CMOVGE-cmovccname 14 = CMOVLE-cmovccname 15 = CMOVG--parseGrp1 0x80 = do-  (op1, op2, mod, reg, rm) <- parseAddress32 OP8-  immb <- anyWord8-  return $ Instr (aluOps !! fromIntegral reg) OP8 -    [op1, OpImm (fromIntegral immb)]-parseGrp1 0x81 = do-  opsize <- instrOperandSize-  (op1, op2, mod, reg, rm) <- parseAddress32 opsize-  immb <- anyWordZ-  return $ Instr (aluOps !! fromIntegral reg) opsize -    [op1, OpImm (fromIntegral immb)]-parseGrp1 0x82 = do-  (op1, op2, mod, reg, rm) <- parseAddress32 OP8-  immb <- anyWord8-  return $ Instr (aluOps !! fromIntegral reg) OP8 -    [op1, OpImm (fromIntegral immb)]-parseGrp1 0x83 = do-  opsize <- instrOperandSize-  (op1, op2, mod, reg, rm) <- parseAddress32 opsize-  immb <- anyWord8-  return $ Instr (aluOps !! fromIntegral reg) opsize-    [op1, OpImm (fromIntegral immb)]-aluOps = [ADD, OR, ADC, SBB, AND, SUB, XOR, CMP]---parseGrp1A b = do-   opsize <- instrOperandSize-   (op1, op2, mod, reg, rm) <- parseAddress32 opsize-   case reg of-     0 -> return $ Instr POP opsize [op1]-     _ -> parseInvalidOpcode b--parseGrp2 0xc0 = do-  (op1, op2, mod, reg, rm) <- parseAddress32 OP8-  immb <- anyWord8-  return $ Instr (shiftOps !! fromIntegral reg) OP8 -      [op1, OpImm (fromIntegral immb)]-parseGrp2 0xc1 = do-  opsize <- instrOperandSize-  (op1, op2, mod, reg, rm) <- parseAddress32 opsize-  imm <- anyWord8-  return $ Instr (shiftOps !! fromIntegral reg) opsize-      [op1, OpImm (fromIntegral imm)]-parseGrp2 0xd0 = do-  (op1, op2, mod, reg, rm) <- parseAddress32 OP8-  return $ Instr (shiftOps !! fromIntegral reg) OP8 [op1, OpImm 1]-parseGrp2 0xd1 = do-  opsize <- instrOperandSize-  (op1, op2, mod, reg, rm) <- parseAddress32 opsize-  return $ Instr (shiftOps !! fromIntegral reg) opsize [op1, OpImm 1]-parseGrp2 0xd2 = do-  (op1, op2, mod, reg, rm) <- parseAddress32 OP8-  return $ Instr (shiftOps !! fromIntegral reg) OP8 [op1, OpReg "cl" 1]-parseGrp2 0xd3 = do-  opsize <- instrOperandSize-  (op1, op2, mod, reg, rm) <- parseAddress32 opsize-  return $ Instr (shiftOps !! fromIntegral reg) opsize [op1, OpReg "cl" 1]-shiftOps = [ROL, ROR, RCL, RCR, SHL, SHR, InvalidOpcode, SAR]--parseGrp3 0xf6 = do-  (op1, op2, mod, reg, rm) <- parseAddress32 OP8-  case reg of-    0 -> do imm <- anyWord8-            return $ Instr TEST OP8 [op1, OpImm (fromIntegral imm)]-    1 -> parseInvalidOpcode 0xf6-    2 -> return $ Instr NOT OP8 [op1]-    3 -> return $ Instr NEG OP8 [op1]-    4 -> return $ Instr MUL OP8 [OpReg "al" 0, op1]-    5 -> return $ Instr IMUL OP8 [OpReg "al" 0, op1]-    6 -> return $ Instr DIV OP8 [OpReg "al" 0, op1]-    7 -> return $ Instr IDIV OP8 [OpReg "al" 0, op1]-parseGrp3 0xf7 = do-  opsize <- instrOperandSize-  (op1, op2, mod, reg, rm) <- parseAddress32 opsize-  rn <- registerName 0-  case reg of-    0 -> do imm <- anyWordZ-            return $ Instr TEST opsize [op1, OpImm (fromIntegral imm)]-    1 -> parseInvalidOpcode 0xf6-    2 -> return $ Instr NOT opsize [op1]-    3 -> return $ Instr NEG opsize [op1]-    4 -> return $ Instr MUL opsize [OpReg rn 0, op1]-    5 -> return $ Instr IMUL opsize [OpReg rn 0, op1]-    6 -> return $ Instr DIV opsize [OpReg rn 0, op1]-    7 -> return $ Instr IDIV opsize [OpReg rn 0, op1]--parseGrp4 b = do-  (op1, op2, mod, reg, rm) <- parseAddress32 OP8-  case reg of-    0 -> return $ Instr INC OP8 [op1]-    1 -> return $ Instr DEC OP8 [op1]-    _ -> parseInvalidOpcode b--parseGrp5 b = do-  opsize <- instrOperandSize-  (op1, op2, mod, reg, rm) <- parseAddress32 opsize-  case reg of-    0 -> return $ Instr INC opsize [op1]-    1 -> return $ Instr DEC opsize [op1]-    2 -> return $ Instr CALL OPNONE [op1]-    3 -> do w <- anyWord16-            return $ Instr CALLF OPNONE [OpAddr (fromIntegral w) OPNONE, op1]-    4 -> return $ Instr JMPN OPNONE [op1]-    5 -> do w <- anyWord16-            return $ Instr JMPF OPNONE [OpAddr (fromIntegral w) OPNONE, op1]-    6 -> return $ Instr PUSH opsize [op1]-    _ -> parseInvalidOpcode b--parseGrp6 b = do-  (op1, op2, mod, reg, rm) <- parseAddress32 OPNONE-  case reg of-    0 -> return $ Instr SLDT OPNONE [op1]-    1 -> return $ Instr STR OPNONE [op1]-    2 -> return $ Instr LLDT OPNONE [op1]-    3 -> return $ Instr LTR OPNONE [op1]-    4 -> return $ Instr VERR OPNONE [op1]-    5 -> return $ Instr VERW OPNONE [op1]-    _ -> parseInvalidOpcode b--parseGrp7 b = do-  (op1, op2, mod, reg, rm) <- parseAddress32 OPNONE-  case mod of-    3 -> case reg of-           0 -> case rm of-       		  1 -> return $ Instr VMCALL OPNONE []-       		  2 -> return $ Instr VMLAUNCH OPNONE []-       		  3 -> return $ Instr VMRESUME OPNONE []-       		  4 -> return $ Instr VMXOFF OPNONE []-       		  _ -> parseInvalidOpcode b-           1 -> case rm of-       		  0 -> return $ Instr MONITOR OPNONE []-       		  1 -> return $ Instr MWAIT OPNONE []-       		  _ -> parseInvalidOpcode b-           4 -> return $ Instr SMSW OPNONE [op1]-           6 -> return $ Instr LMSW OPNONE [op1]-           7 -> case rm of-       		  0 -> onlyIn64BitMode-       	                 (\b -> return $ Instr SWAPGS OPNONE []) b-       		  _ -> parseInvalidOpcode b-           _ -> parseInvalidOpcode b-    _ -> case reg of-           0 -> return $ Instr SGDT OPNONE [op1]-           1 -> return $ Instr SIDT OPNONE [op1]-           2 -> return $ Instr LGDT OPNONE [op1]-           3 -> return $ Instr LIDT OPNONE [op1]-           4 -> return $ Instr SMSW OPNONE [op1]-           5 -> parseInvalidOpcode b-           6 -> return $ Instr LMSW OPNONE [op1]-           7 -> return $ Instr INVLPG OPNONE [op1]--parseGrp8 b = do-  opsize <- instrOperandSize-  (op1, op2, mod, reg, rm) <- parseAddress32 opsize-  imm <- anyWord8-  case reg of-    4 -> return $ Instr BT opsize [op1, OpImm (fromIntegral imm)]-    5 -> return $ Instr BTS opsize [op1, OpImm (fromIntegral imm)]-    6 -> return $ Instr BTR opsize [op1, OpImm (fromIntegral imm)]-    7 -> return $ Instr BTC opsize [op1, OpImm (fromIntegral imm)]-    _ -> parseInvalidOpcode b--parseGrp9 b = do-  (op1, op2, mod, reg, rm) <- parseAddress32 OPNONE-  st <- getState-  case mod of-    3 -> parseInvalidOpcode b-    _ -> case reg of-            1 -> if hasREX rex_W st-                    then return $ Instr CMPXCHG16B OPNONE [op1]-                    else return $ Instr CMPXCHG8B OPNONE [op1]-            6 -> if hasPrefix 0x66 st-                   then return $ Instr VMCLEAR OPNONE [op1]-       	     else if hasPrefix 0xf3 st-       	          then return $ Instr VMXON OPNONE [op1]-       	          else return $ Instr VMPTRLD OPNONE [op1]-            7 -> return $ Instr VMPTRST OPNONE [op1]-            _ -> parseInvalidOpcode b--parseGrp10 = parseInvalidOpcode--parseGrp11 0xc6 = do-  (op1, op2, mod, reg, rm) <- parseAddress32 OP8-  imm <- anyWord8-  return $ Instr MOV OP8 [op1, OpImm (fromIntegral imm)]-parseGrp11 0xc7 = do-  opsize <- instrOperandSize-  (op1, op2, mod, reg, rm) <- parseAddress32 opsize-  imm <- anyWordZ-  return $ Instr MOV opsize [op1, OpImm (fromIntegral imm)]--mmxInstr op1 mod reg rm name = do-  st <- getState-  imm <- anyWord8-  if hasPrefix 0x66 st-     then return $ Instr name OP128-           [OpReg (xmmregs !! fromIntegral rm) (fromIntegral rm),-	    OpImm (fromIntegral imm)]-     else return $ Instr name OP64-           [OpReg (mmxregs !! fromIntegral rm) (fromIntegral rm),-	    OpImm (fromIntegral imm)]-       	-parseGrp12 b = do-  st <- getState-  let opsize = if hasPrefix 0x66 st then OP128 else OP64-  (op1, op2, mod, reg, rm) <- parseAddress32 opsize-  case mod of-    3 -> case reg of-           2 -> mmxInstr op1 mod reg rm PSRLW-           4 -> mmxInstr op1 mod reg rm PSRAW-           6 -> mmxInstr op1 mod reg rm PSLLW-           _ -> parseInvalidOpcode b-    _ -> parseInvalidOpcode b-parseGrp13 b = do-  st <- getState-  let opsize = if hasPrefix 0x66 st then OP128 else OP64-  (op1, op2, mod, reg, rm) <- parseAddress32 opsize-  case mod of-    3 -> case reg of-           2 -> mmxInstr op1 mod reg rm PSRLD-           4 -> mmxInstr op1 mod reg rm PSRAD-           6 -> mmxInstr op1 mod reg rm PSLLD-           _ -> parseInvalidOpcode b-    _ -> parseInvalidOpcode b-parseGrp14 b = do-  st <- getState-  let opsize = if hasPrefix 0x66 st then OP128 else OP64-  (op1, op2, mod, reg, rm) <- parseAddress32 opsize-  st <- getState-  case mod of-    3 -> case reg of-           2 -> mmxInstr op1 mod reg rm PSRLQ-           3 -> if hasPrefix 0x66 st-		   then mmxInstr op1 mod reg rm PSRLDQ-       		   else parseInvalidOpcode b-           6 -> mmxInstr op1 mod reg rm PSLLQ-           7 -> if hasPrefix 0x66 st-                   then mmxInstr op1 mod reg rm PSLLDQ-       	           else parseInvalidOpcode b-	   _ -> parseInvalidOpcode b-    _ -> parseInvalidOpcode b--parseGrp15 b = do-  (op1, op2, mod, reg, rm) <- parseAddress32 OPNONE-  case mod of-    3 -> case reg of-            5 -> return $ Instr LFENCE OPNONE []-            6 -> return $ Instr MFENCE OPNONE []-            7 -> return $ Instr SFENCE OPNONE []-            _ -> parseInvalidOpcode b-    _ -> case reg of-            0 -> return $ Instr FXSAVE OPNONE [op1]-            1 -> return $ Instr FXRSTOR OPNONE [op1]-            2 -> return $ Instr LDMXCSR OPNONE [op1]-            3 -> return $ Instr STMXCSR OPNONE [op1]-            7 -> return $ Instr CLFLUSH OPNONE [op1]-            _ -> parseInvalidOpcode b-parseGrp16 b = do-  (op1, op2, mod, reg, rm) <- parseAddress32 OPNONE-  case mod of-    3 -> parseInvalidOpcode b-    _ -> case reg of-            0 -> return $ Instr PREFETCHNTA OPNONE [op1]-            1 -> return $ Instr PREFETCHT0 OPNONE [op1]-            2 -> return $ Instr PREFETCHT1 OPNONE [op1]-            3 -> return $ Instr PREFETCHT2 OPNONE [op1]-            _ -> parseInvalidOpcode b--parseXmmVW p p0xf3 p0x66 p0xf2 b =-    do (op1, op2, mod, reg, rm) <- parseAddress32 OP128-       st <- getState-       let v = OpReg (xmmregs !! (fromIntegral reg)) (fromIntegral reg)-       let w = case op1 of-	         OpReg _ num -> OpReg (xmmregs !! num) num-		 op -> op-       if hasPrefix 0xf3 st-	  then return $ Instr p0xf3 OP128 [v, w]-	  else if hasPrefix 0x66 st-	          then return $ Instr p0x66 OP128 [v, w]-		  else if hasPrefix 0xf2 st-		          then return $ Instr p0xf2 OP128 [v, w]-			  else return $ Instr p OP128 [v, w]-parseXmmWV p p0xf3 p0x66 p0xf2 b =-    do (op1, op2, mod, reg, rm) <- parseAddress32 OP128-       st <- getState-       let w = OpReg (xmmregs !! (fromIntegral reg)) (fromIntegral reg)-       let v = case op1 of-	         OpReg _ num -> OpReg (xmmregs !! num) num-		 op -> op-       if hasPrefix 0xf3 st-	  then return $ Instr p0xf3 OP128 [v, w]-	  else if hasPrefix 0x66 st-	          then return $ Instr p0x66 OP128 [v, w]-		  else if hasPrefix 0xf2 st-		          then return $ Instr p0xf2 OP128 [v, w]-			  else return $ Instr p OP128 [v, w]--parseXmmGU p p0xf3 p0x66 p0xf2 b =-    do (mod, reg, rm) <- parseModRM-       st <- getState-       let g = OpReg (regnames32 !! (fromIntegral reg)) (fromIntegral reg)-       let u = OpReg (xmmregs !! (fromIntegral rm)) (fromIntegral rm)-       if hasPrefix 0xf3 st-	  then return $ Instr p0xf3 OP32 [g, u]-	  else if hasPrefix 0x66 st-	          then return $ Instr p0x66 OP32 [g, u]-		  else if hasPrefix 0xf2 st-		          then return $ Instr p0xf2 OP32 [g, u]-			  else return $ Instr p OP32 [g, u]--parseMOVUPS b@0x10 = parseXmmVW MOVUPS MOVSS MOVUPD MOVSD b-parseMOVUPS b@0x11 = parseXmmWV MOVUPS MOVSS MOVUPD MOVSD b-parseMOVLPS b@0x12 = parseXmmWV MOVLPS MOVSLDUP MOVLPD MOVDDUP b-parseMOVLPS b@0x13 = parseXmmVW MOVLPS InvalidOpcode MOVLPD InvalidOpcode b-parseUNPCKLPS b@0x14 =-    parseXmmVW UNPCKLPS InvalidOpcode UNPCKLPD InvalidOpcode b-parseUNPCKHPS b@0x15 = -    parseXmmVW UNPCKHPS InvalidOpcode UNPCKHPD InvalidOpcode b-parseMOVHPS b@0x16 = parseXmmVW MOVHPS MOVLSDUP MOVHPD MOVLHPS b-parseMOVHPS b@0x17 = parseXmmVW MOVHPS InvalidOpcode MOVHPD InvalidOpcode b--parseMOVCtrlDebug 0x20 = -    do (mod, reg, rm) <- parseModRM-       return $ Instr MOV OPNONE [OpReg (regnames32 !! fromIntegral rm)-				  (fromIntegral rm),-				  OpReg ("cr" ++ show reg) (fromIntegral reg)]-parseMOVCtrlDebug 0x21 = -    do (mod, reg, rm) <- parseModRM-       return $ Instr MOV OPNONE [OpReg (regnames32 !! fromIntegral rm)-				  (fromIntegral rm),-				  OpReg ("db" ++ show reg) (fromIntegral reg)]-parseMOVCtrlDebug 0x22 = -    do (mod, reg, rm) <- parseModRM-       return $ Instr MOV OPNONE [OpReg ("cr" ++ show reg) (fromIntegral reg),-				  OpReg (regnames32 !! fromIntegral rm)-				  (fromIntegral rm)]-parseMOVCtrlDebug 0x23 = -    do (mod, reg, rm) <- parseModRM-       return $ Instr MOV OPNONE [OpReg ("db" ++ show reg) (fromIntegral reg),-				  OpReg (regnames32 !! fromIntegral rm)-				  (fromIntegral rm)]-  --parseMOVAPS b@0x28 = parseXmmVW MOVAPS InvalidOpcode MOVAPD InvalidOpcode b-parseMOVAPS b@0x29 = parseXmmWV MOVAPS InvalidOpcode MOVAPD InvalidOpcode b-parseCVTI2PS = parseUnimplemented-parseMOVNTPS = parseXmmWV MOVNTPS InvalidOpcode MOVNTPD InvalidOpcode-parseCVTPS2PI = parseUnimplemented-parseCVTTPS2PI = parseUnimplemented-parseUCOMISS = parseXmmVW UCOMISS InvalidOpcode UCOMISD InvalidOpcode-parseCOMISS = parseXmmVW COMISS InvalidOpcode COMISD InvalidOpcode--parseCMOVcc b= do-  opsize <- instrOperandSize-  (op1, op2, mod, reg, rm) <- parseAddress32 opsize-  return $ Instr (cmovccname (b .&. 0xf)) OPNONE [op2, op1]-  -parseMOVSKPS = parseXmmGU MOVMSKPS InvalidOpcode MOVMSKPD InvalidOpcode--parseSQRTPS = parseXmmVW SQRTPS SQRTSS SQRTPD SQRTSD-parseRSQRTPS = parseXmmVW RSQRTPS RSQRTSS InvalidOpcode InvalidOpcode-parseRCPPS = parseXmmVW RCPPS RCPSS InvalidOpcode InvalidOpcode-parseCVTPS2PD = parseUnimplemented-parseANDNPS = parseXmmVW ANDNPS InvalidOpcode ANDNPD InvalidOpcode-parseANDPS =  parseXmmVW ANDPS InvalidOpcode ANDPD InvalidOpcode-parseORPS = parseXmmVW ORPS InvalidOpcode ORPD InvalidOpcode-parseXORPS = parseXmmVW XORPS InvalidOpcode XORPD InvalidOpcode-parseADDPS = parseXmmVW ADDPS ADDSS ADDPD ADDSD-parseMULPS = parseXmmVW MULPS MULSS MULPD MULSD-parseCVTDQ2PS = parseUnimplemented-parsePUNPCKLWD = parseUnimplemented-parsePACKSSWB = parseUnimplemented-parsePUNPCKHWD = parseUnimplemented-parseSUBPS = parseXmmVW SUBPS SUBSS SUBPD SUBSD-parseMINPS = parseXmmVW MINPS MINSS MINPD MINSD-parseDIVPS = parseXmmVW DIVPS DIVSS DIVPD DIVSD-parseMAXPS = parseXmmVW MAXPS MAXSS MAXPD MAXSD-parsePUNPCKLBW = parseUnimplemented-parsePUNPCKLDQ = parseUnimplemented-parsePACKUSWB = parseUnimplemented-parsePCMPGTB = parseUnimplemented-parsePCMPGTW = parseUnimplemented-parsePCMPGTD = parseUnimplemented-parsePUNPCKHBW = parseUnimplemented-parsePUNPCKHDQ = parseUnimplemented-parsePACKSSDW = parseUnimplemented-parsePUNPCKLQDQ = parseUnimplemented-parsePUNPCKHQDQ = parseUnimplemented-parsePSHUFW = parseUnimplemented-parsePCMPEQB = parseUnimplemented-parsePCMPEQW = parseUnimplemented-parsePCMPEQD = parseUnimplemented--parseVMREAD b = -    do st <- getState-       if in64BitMode st-	  then do (op1, op2, mod, reg, rm) <- parseAddress32 OP64-		  return $ Instr VMREAD OP64 [op1, op2]-	  else do (op1, op2, mod, reg, rm) <- parseAddress32 OP32-		  return $ Instr VMREAD OP32 [op1, op2]-parseVMWRITE b = -    do st <- getState-       if in64BitMode st-	  then do (op1, op2, mod, reg, rm) <- parseAddress32 OP64-		  return $ Instr VMWRITE OP64 [op1, op2]-	  else do (op1, op2, mod, reg, rm) <- parseAddress32 OP32-		  return $ Instr VMWRITE OP32 [op1, op2]--parseHADDPS = parseXmmVW InvalidOpcode InvalidOpcode HADDPD HADDPS-parseHSUBPS = parseXmmVW InvalidOpcode InvalidOpcode HSUBPS HSUBPD--parseMOVD_Q = parseUnimplemented--parseJccLong b = do-  disp <- anyIntZ-  let disp' :: Int-      disp' = fromIntegral disp-  pos <- getPosition-  st <- getState-  return $ Instr (jccname (b .&. 0xf)) OPNONE-        [OpAddr (fromIntegral (disp' + sourceColumn pos - 1) +-                (startAddr st)) OPNONE]--parseSETcc b = do-  (op1, op2, mod, reg, rm) <- parseAddress32 OP8-  case op1 of-    OpReg name num -> return $ Instr (setccname (b .&. 0xf)) OPNONE -		      [OpReg (regnames8 !! fromIntegral num) num]-    _ -> return $ Instr (setccname (b .&. 0xf)) OPNONE [op1]--parseSHLD 0xa4 = -    do opsize <- instrOperandSize-       (op1, op2, mod, reg, rm) <- parseAddress32 opsize-       b <- anyWord8-       opsize <- instrOperandSize-       return $ Instr SHLD opsize [op1, op2, OpImm (fromIntegral b)]-parseSHLD 0xa5 = -    do opsize <- instrOperandSize-       (op1, op2, mod, reg, rm) <- parseAddress32 opsize-       opsize <- instrOperandSize-       return $ Instr SHLD opsize [op1, op2, OpReg "cl" 1]-parseSHRD 0xac = -    do opsize <- instrOperandSize-       (op1, op2, mod, reg, rm) <- parseAddress32 opsize-       b <- anyWord8-       opsize <- instrOperandSize-       return $ Instr SHRD opsize [op1, op2, OpImm (fromIntegral b)]-parseSHRD 0xad = -    do opsize <- instrOperandSize-       (op1, op2, mod, reg, rm) <- parseAddress32 opsize-       opsize <- instrOperandSize-       return $ Instr SHRD opsize [op1, op2, OpReg "cl" 1]--parseCMPPS = parseUnimplemented-parseMOVNTI = parseUnimplemented-parsePINSRW = parseUnimplemented-parsePEXTRW = parseUnimplemented-parseSHUFPS = parseUnimplemented--parseBSWAP b = -    do let reg = (b .&. 0xf) - 8-       r <- registerName (fromIntegral reg)-       opsize <- instrOperandSize-       return $ Instr BSWAP opsize [OpReg r (fromIntegral reg)]--parseADDSUBPS = parseXmmVW InvalidOpcode InvalidOpcode ADDSUBPD ADDUBPS--parseMmxXmmPQVW opcode b =-    do st <- getState-       if hasPrefix 0x66 st-	  then do (op1, op2, mod, reg, rm) <- parseAddress32 OP128-		  let v = OpReg (xmmregs !! (fromIntegral reg)) -			  (fromIntegral reg)-		  let w = case op1 of-			    OpReg _ num -> OpReg (xmmregs !! num) num-			    op -> op-		  return $ Instr opcode OP128 [v, w]-	  else do (op1, op2, mod, reg, rm) <- parseAddress32 OP64-		  let p = OpReg (mmxregs !! (fromIntegral reg)) -			  (fromIntegral reg)-		  let q = case op1 of-			    OpReg _ num -> OpReg (mmxregs !! num) num-			    op -> op-		  return $ Instr opcode OP128 [p, q]--parseMmxXmmMPMV opcode1 opcode2 b =-    do st <- getState-       if hasPrefix 0x66 st-	  then do (op1, op2, mod, reg, rm) <- parseAddress32 OP128-		  let v = OpReg (xmmregs !! (fromIntegral reg)) -			  (fromIntegral reg)-		  return $ Instr opcode2 OP128 [op1, v]-	  else do (op1, op2, mod, reg, rm) <- parseAddress32 OP64-		  let p = OpReg (mmxregs !! (fromIntegral reg)) -			  (fromIntegral reg)-		  return $ Instr opcode1 OP128 [op1, p]--parseMmxXmmPNVU opcode b =-    do st <- getState-       if hasPrefix 0x66 st-	  then do (mod, reg, rm) <- parseModRM-		  let v = OpReg (xmmregs !! (fromIntegral reg)) -			  (fromIntegral reg)-		  let u = OpReg (xmmregs !! (fromIntegral rm))-			  (fromIntegral reg)-		  return $ Instr opcode OP128 [v, u]-	  else do (op1, op2, mod, reg, rm) <- parseAddress32 OP64-		  let p = OpReg (mmxregs !! (fromIntegral reg)) -			  (fromIntegral reg)-		  let n = OpReg (mmxregs !! (fromIntegral rm))-			  (fromIntegral reg)-		  return $ Instr opcode OP128 [p, n]--parsePSRLW = parseMmxXmmPQVW PSRLW-parsePSRLD = parseMmxXmmPQVW PSRLD-parsePSRLQ = parseMmxXmmPQVW PSRLQ-parsePADDQ = parseMmxXmmPQVW PADDQ-parsePMULLW = parseMmxXmmPQVW PMULLW-parseMOVQ b@0x6f = parseUnimplemented b-parseMOVQ b@0x7f = parseUnimplemented b-parseMOVQ b@0xd6 = -    do st <- getState-       if hasPrefix 0x66 st-	  then do (op1, op2, mod, reg, rm) <- parseAddress32 OP64-		  return $ Instr MOVQ OP64 [op1, op2]-	  else if hasPrefix 0xf3 st-	          then do (mod, reg, rm) <- parseModRM-			  return $ Instr MOVQ OPNONE -				     [OpReg (xmmregs !! (fromIntegral reg))-				      (fromIntegral reg),-				      OpReg (mmxregs !! (fromIntegral rm))-				      (fromIntegral rm)]-		  else-		    if hasPrefix 0xf2 st-		       then do (mod, reg, rm) <- parseModRM-			       return $ Instr MOVQ OPNONE-				[OpReg (mmxregs !! (fromIntegral reg))-				 (fromIntegral reg),-				 OpReg (xmmregs !! (fromIntegral rm))-				 (fromIntegral rm)]-		       else parseInvalidOpcode b-			  -parsePMOVMSKB b = -    do st <- getState-       (mod, reg, rm) <- parseModRM-       if hasPrefix 0x66 st-	  then do return $ Instr PMOVMSKB OPNONE -			     [OpReg (regnames32 !! (fromIntegral reg))-			      (fromIntegral reg),-			      OpReg (xmmregs !! (fromIntegral rm))-			      (fromIntegral rm)]-	  else do return $ Instr PMOVMSKB OPNONE -			     [OpReg (regnames32 !! (fromIntegral reg))-			      (fromIntegral reg),-			      OpReg (mmxregs !! (fromIntegral rm))-			      (fromIntegral rm)]-parsePSUBUSB = parseMmxXmmPQVW PSUBUSB-parsePSUBUSW = parseMmxXmmPQVW PSUBUSW-parsePMINUB = parseMmxXmmPQVW PMINUB-parsePAND = parseMmxXmmPQVW PAND-parsePADDUSB = parseMmxXmmPQVW PADDUSB-parsePADDUSW = parseMmxXmmPQVW PADDUSW-parsePMAXUB = parseMmxXmmPQVW PMAXUB-parsePANDN = parseMmxXmmPQVW PANDN-parsePAVGB = parseMmxXmmPQVW PAVGB-parsePSRAW = parseMmxXmmPQVW PSRAW-parsePSRAD = parseMmxXmmPQVW PSRAD-parsePAVGW = parseMmxXmmPQVW PAVGW-parseCVTPD2DQ = parseUnimplemented-parsePMULHUW = parseMmxXmmPQVW PMULHUW-parsePMULHW = parseMmxXmmPQVW PMULHW-parseMOVNTQ = parseMmxXmmMPMV MOVNTQ MOVNTDQ-parsePSUBSB = parseMmxXmmPQVW PSUBSB-parsePSUBSQ = parseMmxXmmPQVW PSUBSQ-parsePMINSW = parseMmxXmmPQVW PMINSW-parsePOR = parseMmxXmmPQVW POR-parsePADDSB = parseMmxXmmPQVW PADDSB-parsePADDSW = parseMmxXmmPQVW PADDSW-parsePMAXSW = parseMmxXmmPQVW PMAXSW-parsePXOR = parseMmxXmmPQVW PXOR-parseLDDQU b = -    do st <- getState-       if hasPrefix 0xf2 st-	  then do (op1, op2, mod, reg, rm) <- parseAddress32 OP128-		  let v = OpReg (xmmregs !! (fromIntegral reg))-		          (fromIntegral reg)-		  return $ Instr LDDQU OP128 [v, op1]-	  else parseInvalidOpcode b-parsePSLLW = parseMmxXmmPQVW PSLLW-parsePSLLD = parseMmxXmmPQVW PSLLD-parsePSLLQ = parseMmxXmmPQVW PSLLQ-parsePMULUDQ = parseMmxXmmPQVW PMULUDQ-parsePMADDWD = parseMmxXmmPQVW PMADDWD-parsePSADBW = parseMmxXmmPQVW PSADBW-parseMASKMOVQ = parseMmxXmmPNVU MASKMOVQ-parsePSUBB = parseMmxXmmPQVW PSUBB-parsePSUBW = parseMmxXmmPQVW PSUBW-parsePSUBD = parseMmxXmmPQVW PSUBD-parsePSUBQ = parseMmxXmmPQVW PSUBQ-parsePADDB = parseMmxXmmPQVW PADDB-parsePADDW = parseMmxXmmPQVW PADDW-parsePADDD = parseMmxXmmPQVW PADDD+-- This is a module for compatibility with earlier Harpy releases.  It+-- re-exports the disassembler from the disassembler package.+--------------------------------------------------------------------------++module Harpy.X86Disassembler(+  -- * Types+  Opcode,+  Operand(..),+  InstrOperandSize(..),+  Instruction(..),+  ShowStyle(..),+  -- * Functions+  disassembleBlock,+  disassembleList,+  disassembleArray,+  showIntel,+  showAtt+  ) where++import Text.Disassembler.X86Disassembler

@@ -1,6 +1,29 @@ 							-*-outline-*- * Harpy NEWS +** New in version 0.4.2++*** package structure++- The disassembler is now in a separate package, and is re-exported for+  compatibility by Harpy. This allows us to give the more liberal BSD licence+  to the disassembler.++*** New instructions++- The "mov", "jcc" (jump on condition code), and "cmp" instructions support+  "Ptr a" as operand++- Henning Thielemann provided some further floating point and SSE+  instructions.++- The loop instruction supports labels now.++*** Enhancements++- The disassembly of Harpy's internal code buffers includes all labels+  now, even when multiple labels are defined for the same location.+ ** New in version 0.4.1  *** New Instances

@@ -1,12 +1,12 @@ Cabal-version:  >=1.2 Build-type: Simple Name:           harpy-Version:        0.4.1+Version:        0.4.2 License:        GPL License-file:   COPYING Author:         Dirk Kleeblatt <klee@cs.tu-berlin.de>-                Martin Grabmueller <magr@cs.tu-berlin.de>-Maintainer:     klee@cs.tu-berlin.de, magr@cs.tu-berlin.de+                Martin Grabmueller <martin.grabmueller@eleven.de>+Maintainer:     klee@cs.tu-berlin.de, martin.grabmueller@eleven.de Homepage:       http://uebb.cs.tu-berlin.de/harpy/ Category:       Code Generation Synopsis:       Runtime code generation for x86 machine code@@ -20,7 +20,9 @@ 	* An x86 disassembler which knows most of the opcodes available on 	  modern x86 processors and can display its output both in the style 	  used in Intel documents an in AT&T style, like the GNU tools. The-	  disassmbler can be found in module "Harpy.X86Disassembler".+	  disassembler can be found in module "Harpy.X86Disassembler".  The+          disassembler is re-exported from the disassembler package for+          compatibility with earlier Harpy releases. 	. 	* Some abstractions over the abovementioned code generation modules, 	  such as automatic label management and code generation@@ -45,9 +47,10 @@  Library   if flag(small_base)-    Build-depends:  base >= 3,parsec,mtl,template-haskell,pretty,containers,array+    Build-depends:  base >= 3 && < 4,parsec,mtl,template-haskell,pretty,containers,array   else     Build-Depends: base < 3,parsec,mtl,template-haskell+  Build-depends: disassembler >= 0.1.0   Exposed-Modules:     Harpy,     Harpy.X86CodeGen,