packages feed

harpy (empty) → 0.2

raw patch · 12 files changed

+9377/−0 lines, 12 filesdep +basedep +mtldep +parsecbuild-type:Customsetup-changed

Dependencies added: base, mtl, parsec, template-haskell

Files

+ COPYING view
@@ -0,0 +1,340 @@+		    GNU GENERAL PUBLIC LICENSE+		       Version 2, June 1991++ Copyright (C) 1989, 1991 Free Software Foundation, Inc.+     51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA+ Everyone is permitted to copy and distribute verbatim copies+ of this license document, but changing it is not allowed.++			    Preamble++  The licenses for most software are designed to take away your+freedom to share and change it.  By contrast, the GNU General Public+License is intended to guarantee your freedom to share and change free+software--to make sure the software is free for all its users.  This+General Public License applies to most of the Free Software+Foundation's software and to any other program whose authors commit to+using it.  (Some other Free Software Foundation software is covered by+the GNU Library General Public License instead.)  You can apply it to+your programs, too.++  When we speak of free software, we are referring to freedom, not+price.  Our General Public Licenses are designed to make sure that you+have the freedom to distribute copies of free software (and charge for+this service if you wish), that you receive source code or can get it+if you want it, that you can change the software or use pieces of it+in new free programs; and that you know you can do these things.++  To protect your rights, we need to make restrictions that forbid+anyone to deny you these rights or to ask you to surrender the rights.+These restrictions translate to certain responsibilities for you if you+distribute copies of the software, or if you modify it.++  For example, if you distribute copies of such a program, whether+gratis or for a fee, you must give the recipients all the rights that+you have.  You must make sure that they, too, receive or can get the+source code.  And you must show them these terms so they know their+rights.++  We protect your rights with two steps: (1) copyright the software, and+(2) offer you this license which gives you legal permission to copy,+distribute and/or modify the software.++  Also, for each author's protection and ours, we want to make certain+that everyone understands that there is no warranty for this free+software.  If the software is modified by someone else and passed on, we+want its recipients to know that what they have is not the original, so+that any problems introduced by others will not reflect on the original+authors' reputations.++  Finally, any free program is threatened constantly by software+patents.  We wish to avoid the danger that redistributors of a free+program will individually obtain patent licenses, in effect making the+program proprietary.  To prevent this, we have made it clear that any+patent must be licensed for everyone's free use or not licensed at all.++  The precise terms and conditions for copying, distribution and+modification follow.++		    GNU GENERAL PUBLIC LICENSE+   TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION++  0. This License applies to any program or other work which contains+a notice placed by the copyright holder saying it may be distributed+under the terms of this General Public License.  The "Program", below,+refers to any such program or work, and a "work based on the Program"+means either the Program or any derivative work under copyright law:+that is to say, a work containing the Program or a portion of it,+either verbatim or with modifications and/or translated into another+language.  (Hereinafter, translation is included without limitation in+the term "modification".)  Each licensee is addressed as "you".++Activities other than copying, distribution and modification are not+covered by this License; they are outside its scope.  The act of+running the Program is not restricted, and the output from the Program+is covered only if its contents constitute a work based on the+Program (independent of having been made by running the Program).+Whether that is true depends on what the Program does.++  1. You may copy and distribute verbatim copies of the Program's+source code as you receive it, in any medium, provided that you+conspicuously and appropriately publish on each copy an appropriate+copyright notice and disclaimer of warranty; keep intact all the+notices that refer to this License and to the absence of any warranty;+and give any other recipients of the Program a copy of this License+along with the Program.++You may charge a fee for the physical act of transferring a copy, and+you may at your option offer warranty protection in exchange for a fee.++  2. You may modify your copy or copies of the Program or any portion+of it, thus forming a work based on the Program, and copy and+distribute such modifications or work under the terms of Section 1+above, provided that you also meet all of these conditions:++    a) You must cause the modified files to carry prominent notices+    stating that you changed the files and the date of any change.++    b) You must cause any work that you distribute or publish, that in+    whole or in part contains or is derived from the Program or any+    part thereof, to be licensed as a whole at no charge to all third+    parties under the terms of this License.++    c) If the modified program normally reads commands interactively+    when run, you must cause it, when started running for such+    interactive use in the most ordinary way, to print or display an+    announcement including an appropriate copyright notice and a+    notice that there is no warranty (or else, saying that you provide+    a warranty) and that users may redistribute the program under+    these conditions, and telling the user how to view a copy of this+    License.  (Exception: if the Program itself is interactive but+    does not normally print such an announcement, your work based on+    the Program is not required to print an announcement.)++These requirements apply to the modified work as a whole.  If+identifiable sections of that work are not derived from the Program,+and can be reasonably considered independent and separate works in+themselves, then this License, and its terms, do not apply to those+sections when you distribute them as separate works.  But when you+distribute the same sections as part of a whole which is a work based+on the Program, the distribution of the whole must be on the terms of+this License, whose permissions for other licensees extend to the+entire whole, and thus to each and every part regardless of who wrote it.++Thus, it is not the intent of this section to claim rights or contest+your rights to work written entirely by you; rather, the intent is to+exercise the right to control the distribution of derivative or+collective works based on the Program.++In addition, mere aggregation of another work not based on the Program+with the Program (or with a work based on the Program) on a volume of+a storage or distribution medium does not bring the other work under+the scope of this License.++  3. You may copy and distribute the Program (or a work based on it,+under Section 2) in object code or executable form under the terms of+Sections 1 and 2 above provided that you also do one of the following:++    a) Accompany it with the complete corresponding machine-readable+    source code, which must be distributed under the terms of Sections+    1 and 2 above on a medium customarily used for software interchange; or,++    b) Accompany it with a written offer, valid for at least three+    years, to give any third party, for a charge no more than your+    cost of physically performing source distribution, a complete+    machine-readable copy of the corresponding source code, to be+    distributed under the terms of Sections 1 and 2 above on a medium+    customarily used for software interchange; or,++    c) Accompany it with the information you received as to the offer+    to distribute corresponding source code.  (This alternative is+    allowed only for noncommercial distribution and only if you+    received the program in object code or executable form with such+    an offer, in accord with Subsection b above.)++The source code for a work means the preferred form of the work for+making modifications to it.  For an executable work, complete source+code means all the source code for all modules it contains, plus any+associated interface definition files, plus the scripts used to+control compilation and installation of the executable.  However, as a+special exception, the source code distributed need not include+anything that is normally distributed (in either source or binary+form) with the major components (compiler, kernel, and so on) of the+operating system on which the executable runs, unless that component+itself accompanies the executable.++If distribution of executable or object code is made by offering+access to copy from a designated place, then offering equivalent+access to copy the source code from the same place counts as+distribution of the source code, even though third parties are not+compelled to copy the source along with the object code.++  4. You may not copy, modify, sublicense, or distribute the Program+except as expressly provided under this License.  Any attempt+otherwise to copy, modify, sublicense or distribute the Program is+void, and will automatically terminate your rights under this License.+However, parties who have received copies, or rights, from you under+this License will not have their licenses terminated so long as such+parties remain in full compliance.++  5. You are not required to accept this License, since you have not+signed it.  However, nothing else grants you permission to modify or+distribute the Program or its derivative works.  These actions are+prohibited by law if you do not accept this License.  Therefore, by+modifying or distributing the Program (or any work based on the+Program), you indicate your acceptance of this License to do so, and+all its terms and conditions for copying, distributing or modifying+the Program or works based on it.++  6. Each time you redistribute the Program (or any work based on the+Program), the recipient automatically receives a license from the+original licensor to copy, distribute or modify the Program subject to+these terms and conditions.  You may not impose any further+restrictions on the recipients' exercise of the rights granted herein.+You are not responsible for enforcing compliance by third parties to+this License.++  7. If, as a consequence of a court judgment or allegation of patent+infringement or for any other reason (not limited to patent issues),+conditions are imposed on you (whether by court order, agreement or+otherwise) that contradict the conditions of this License, they do not+excuse you from the conditions of this License.  If you cannot+distribute so as to satisfy simultaneously your obligations under this+License and any other pertinent obligations, then as a consequence you+may not distribute the Program at all.  For example, if a patent+license would not permit royalty-free redistribution of the Program by+all those who receive copies directly or indirectly through you, then+the only way you could satisfy both it and this License would be to+refrain entirely from distribution of the Program.++If any portion of this section is held invalid or unenforceable under+any particular circumstance, the balance of the section is intended to+apply and the section as a whole is intended to apply in other+circumstances.++It is not the purpose of this section to induce you to infringe any+patents or other property right claims or to contest validity of any+such claims; this section has the sole purpose of protecting the+integrity of the free software distribution system, which is+implemented by public license practices.  Many people have made+generous contributions to the wide range of software distributed+through that system in reliance on consistent application of that+system; it is up to the author/donor to decide if he or she is willing+to distribute software through any other system and a licensee cannot+impose that choice.++This section is intended to make thoroughly clear what is believed to+be a consequence of the rest of this License.++  8. If the distribution and/or use of the Program is restricted in+certain countries either by patents or by copyrighted interfaces, the+original copyright holder who places the Program under this License+may add an explicit geographical distribution limitation excluding+those countries, so that distribution is permitted only in or among+countries not thus excluded.  In such case, this License incorporates+the limitation as if written in the body of this License.++  9. The Free Software Foundation may publish revised and/or new versions+of the General Public License from time to time.  Such new versions will+be similar in spirit to the present version, but may differ in detail to+address new problems or concerns.++Each version is given a distinguishing version number.  If the Program+specifies a version number of this License which applies to it and "any+later version", you have the option of following the terms and conditions+either of that version or of any later version published by the Free+Software Foundation.  If the Program does not specify a version number of+this License, you may choose any version ever published by the Free Software+Foundation.++  10. If you wish to incorporate parts of the Program into other free+programs whose distribution conditions are different, write to the author+to ask for permission.  For software which is copyrighted by the Free+Software Foundation, write to the Free Software Foundation; we sometimes+make exceptions for this.  Our decision will be guided by the two goals+of preserving the free status of all derivatives of our free software and+of promoting the sharing and reuse of software generally.++			    NO WARRANTY++  11. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY+FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW.  EXCEPT WHEN+OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES+PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED+OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF+MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE.  THE ENTIRE RISK AS+TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU.  SHOULD THE+PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING,+REPAIR OR CORRECTION.++  12. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING+WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR+REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES,+INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING+OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED+TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY+YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER+PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE+POSSIBILITY OF SUCH DAMAGES.++		     END OF TERMS AND CONDITIONS++	    How to Apply These Terms to Your New Programs++  If you develop a new program, and you want it to be of the greatest+possible use to the public, the best way to achieve this is to make it+free software which everyone can redistribute and change under these terms.++  To do so, attach the following notices to the program.  It is safest+to attach them to the start of each source file to most effectively+convey the exclusion of warranty; and each file should have at least+the "copyright" line and a pointer to where the full notice is found.++    <one line to give the program's name and a brief idea of what it does.>+    Copyright (C) <year>  <name of author>++    This program is free software; you can redistribute it and/or modify+    it under the terms of the GNU General Public License as published by+    the Free Software Foundation; either version 2 of the License, or+    (at your option) any later version.++    This program is distributed in the hope that it will be useful,+    but WITHOUT ANY WARRANTY; without even the implied warranty of+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the+    GNU General Public License for more details.++    You should have received a copy of the GNU General Public License+    along with this program; if not, write to the Free Software+    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA+++Also add information on how to contact you by electronic and paper mail.++If the program is interactive, make it output a short notice like this+when it starts in an interactive mode:++    Gnomovision version 69, Copyright (C) year  name of author+    Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'.+    This is free software, and you are welcome to redistribute it+    under certain conditions; type `show c' for details.++The hypothetical commands `show w' and `show c' should show the appropriate+parts of the General Public License.  Of course, the commands you use may+be called something other than `show w' and `show c'; they could even be+mouse-clicks or menu items--whatever suits your program.++You should also get your employer (if you work as a programmer) or your+school, if any, to sign a "copyright disclaimer" for the program, if+necessary.  Here is a sample; alter the names:++  Yoyodyne, Inc., hereby disclaims all copyright interest in the program+  `Gnomovision' (which makes passes at compilers) written by James Hacker.++  <signature of Ty Coon>, 1 April 1989+  Ty Coon, President of Vice++This General Public License does not permit incorporating your program into+proprietary programs.  If your program is a subroutine library, you may+consider it more useful to permit linking proprietary applications with the+library.  If this is what you want to do, use the GNU Library General+Public License instead of this License.
+ Harpy/Call.hs view
@@ -0,0 +1,35 @@+{-# OPTIONS -cpp #-}++--------------------------------------------------------------------------+-- |+-- Module      :  Call+-- Copyright   :  (c) 2006-2007 Martin Grabmueller and Dirk Kleeblatt+-- License     :  GPL+-- +-- Maintainer  :  {magr,klee}@cs.tu-berlin.de+-- Stability   :  provisional+-- Portability :  non-portable+--+-- Predefined call stubs for run-time generated code.+--------------------------------------------------------------------------++module Harpy.Call where++import Harpy.CodeGenMonad++import Data.Word+import Foreign.Ptr++#ifndef __HADDOCK__++$(callDecl "callAsVoid" [t|()|])+$(callDecl "callAsWord32ToWord32" [t|Word32 -> Word32|])+$(callDecl "callAs7PtrToVoid" [t|forall a b c d e f g . Ptr a -> Ptr b -> Ptr c -> Ptr d -> Ptr e -> Ptr f -> Ptr g -> () |])++#else++callAsVoid :: CodeGen e s ()+callAsWord32ToWord32 :: Word32 -> CodeGen e s Word32+callAs7PtrToVoid :: forall a b c d e f g e' s'. Ptr a -> Ptr b -> Ptr c -> Ptr d -> Ptr e -> Ptr f -> Ptr g -> CodeGen e' s' ()++#endif
+ Harpy/CodeGenMonad.hs view
@@ -0,0 +1,503 @@+{-# OPTIONS -cpp #-}++--------------------------------------------------------------------------+-- |+-- Module      :  CodeGenMonad+-- Copyright   :  (c) 2006-2007 Martin Grabmueller and Dirk Kleeblatt+-- License     :  GPL+-- +-- Maintainer  :  {magr,klee}@cs.tu-berlin.de+-- Stability   :  provisional+-- Portability :  portable (but generated code non-portable)+--+-- Monad for generating x86 machine code at runtime.+--+-- This is a combined reader-state-exception monad which handles all+-- the details of handling code buffers, emitting binary data,+-- relocation etc.+--+-- All the code generation functions in module "Harpy.X86CodeGen"+-- live in this monad and use its error reporting facilities as well+-- as the internal state maintained by the monad.  The user state is+-- independent from the internal state and may be used by+-- higher-level code generation libraries to maintain their own+-- state across code generation operations.+--+--------------------------------------------------------------------------++module Harpy.CodeGenMonad(+    -- * Types+          CodeGen,+          RelocKind(..),+          ErrMsg,+          Reloc,+          Label,+          FixupKind(..),+          CodeGenConfig(..),+          defaultCodeGenConfig,+    -- * Functions+    -- ** General code generator monad operations+          failCodeGen,+    -- ** Accessing code generation internals+          getEntryPoint,+          getCodeOffset,+          getBasePtr,+          getCodeBufferList,+    -- ** Access to user state and environment+          setState,+          getState,+          getEnv,+          withEnv,+    -- ** Label management+          newLabel,+          setLabel,+          defineLabel,+          (@@),+          emitFixup,+          labelAddress,+          emitRelocInfo,+    -- ** Code emission+          emit8,+          emit8At,+          peek8At,+          emit32,+          emit32At,+          checkBufferSize,+          ensureBufferSize,+    -- ** Executing code generation+          runCodeGen,+          runCodeGenWithConfig,+    -- ** Calling generated functions+          callDecl,+    -- ** Interface to disassembler+          disassemble+    ) where++import qualified Harpy.X86Disassembler as Dis++import Control.Monad++import Text.PrettyPrint.HughesPJ+import Text.Printf++import Data.Word+import qualified Data.Map as Map+import Foreign+import System.Cmd+import System.IO++import Control.Monad.Trans++import Language.Haskell.TH.Syntax+++-- | An error message produced by a code generation operation.+type ErrMsg = Doc++-- | The code generation monad, a combined reader-state-exception+-- monad.+newtype CodeGen e s a = CodeGen ((e, CodeGenEnv) -> (s, CodeGenState) -> IO ((s, CodeGenState), Either ErrMsg a))++-- | Configuration of the code generator.+data CodeGenConfig = CodeGenConfig { codeBufferSize :: Int -- ^ Size of individual code buffer blocks. +                                     }++-- | Internal state of the code generator+data CodeGenState = CodeGenState { buffer :: Ptr Word8,+                                   bufferList :: [(Ptr Word8, Int)],+                                   firstBuffer :: Ptr Word8,+                                   bufferOfs :: Int,+                                   bufferSize :: Int,+                                   relocEntries :: [Reloc],+                                   nextLabel :: Int,+                                   definedLabels :: Map.Map Int (Ptr Word8, Int),+                                   pendingFixups :: Map.Map Int [FixupEntry],+                                   config :: CodeGenConfig}++data FixupKind = Fixup8+               | Fixup16+               | Fixup32+               | Fixup32Absolute+               deriving (Show)++data FixupEntry = FixupEntry { fueBuffer :: Ptr Word8,+                               fueOfs :: Int,+                               fueKind :: FixupKind }++data CodeGenEnv = CodeGenEnv { tailContext :: Bool }+   deriving (Show)++-- | Kind of relocation, for example PC-relative+data RelocKind = RelocPCRel -- ^ PC-relative relocation+               | RelocAbsolute -- ^ Absolute address+   deriving (Show)++-- | Relocation entry+data Reloc = Reloc { offset :: Int, +             -- ^ offset in code block which needs relocation+                     kind :: RelocKind,+             -- ^ kind of relocation+                     address :: FunPtr () +             -- ^ target address+           }+   deriving (Show)++-- | Label+data Label = Label Int++unCg :: CodeGen e s a -> ((e, CodeGenEnv) -> (s, CodeGenState) -> IO ((s, CodeGenState), Either ErrMsg a))+unCg (CodeGen a) = a++instance Monad (CodeGen e s) where+    return x = cgReturn x+    fail err = cgFail err+    m >>= k = cgBind m k++-- {-# INLINE cgReturn #-}+cgReturn x = CodeGen (\_env state -> return (state, Right x))+-- {-# INLINE cgFail #-}+cgFail err = CodeGen (\_env state -> return (state, Left (text err)))+-- {-# INLINE cgBind #-}+cgBind m k = CodeGen (\env state -> +               do r1 <- unCg m env state+                  case r1 of+                    (state', Left err) -> return (state', Left err)+                    (state', Right v) -> unCg (k v) env state')++-- | Abort code generation with the given error message.+failCodeGen :: Doc -> CodeGen e s a+failCodeGen d = CodeGen (\_env state -> return (state, Left d))++instance MonadIO (CodeGen e s) where+  liftIO st = CodeGen (\_env state -> do { r <- st; return (state, Right r) })++emptyCodeGenState :: CodeGenState+emptyCodeGenState = CodeGenState { buffer = undefined,+                                   bufferList = [],+                                   firstBuffer = undefined,+                                   bufferOfs = 0,+                                   bufferSize = 0,+                                   relocEntries = [], +                                   nextLabel = 0,+                                   definedLabels = Map.empty,+                                   pendingFixups = Map.empty,+                                   config = defaultCodeGenConfig}++defaultCodeGenConfig :: CodeGenConfig+defaultCodeGenConfig = CodeGenConfig { codeBufferSize = defaultCodeBufferSize }++defaultCodeBufferSize :: Int+defaultCodeBufferSize = 128++-- | Execute code generation, given a user environment and state.+-- The result is a tuple of the resulting user state and either an+-- error message (when code generation failed) or the result of the+-- code generation.+runCodeGen :: CodeGen e s a -> e -> s -> IO (s, Either ErrMsg a)+runCodeGen cg uenv ustate =+    runCodeGenWithConfig cg uenv ustate defaultCodeGenConfig++runCodeGenWithConfig :: CodeGen e s a -> e -> s -> CodeGenConfig -> IO (s, Either ErrMsg a)+runCodeGenWithConfig (CodeGen cg) uenv ustate conf =+    do let initSize = codeBufferSize conf+       arr <- mallocBytes initSize+       let env = CodeGenEnv {tailContext = True}+       let state = emptyCodeGenState{buffer = arr,+                                     bufferList = [],+                                     firstBuffer = arr,+                                     bufferSize = initSize,+                                     config = conf}+       ((ustate', _), res) <- cg (uenv, env) (ustate, state)+       return (ustate', res)++-- | Check whether the code buffer has room for at least the given+-- number of bytes.  This should be called by code generators+-- whenever it cannot be guaranteed that the code buffer is large+-- enough to hold all the generated code.  Lets the code generation+-- monad fail when the buffer overflows.+checkBufferSize :: Int -> CodeGen e s ()+checkBufferSize needed =+    do state <- getInternalState+       unless (bufferOfs state + needed <= bufferSize state)+              (failCodeGen (text "code generation buffer overflow: needed additional" <+> +                            int needed <+> text "bytes (offset =" <+> +                            int (bufferOfs state) <> +                            text ", buffer size =" <+> +                            int (bufferSize state) <> text ")"))++-- | Make sure that the code buffer has room for at least the given+-- number of bytes.  This should be called by code generators+-- whenever it cannot be guaranteed that the code buffer is large+-- enough to hold all the generated code.  Creates a new buffer and+-- places a jump to the new buffer when there is not sufficient space+-- available+ensureBufferSize :: Int -> CodeGen e s ()+ensureBufferSize needed =+    do state <- getInternalState+       unless (bufferOfs state + needed + 5 <= bufferSize state)+              (do let incrSize = max (needed + 16) +                                     (codeBufferSize (config state))+                  arr <- liftIO $ mallocBytes incrSize+                  ofs <- getCodeOffset+                  let buf = buffer state+                      disp :: Int+                      disp = arr `minusPtr` (buf `plusPtr` ofs) - 5+                  emit8 0xe9+                  emit32 (fromIntegral disp)+                  st <- getInternalState+                  setInternalState st{buffer = arr, bufferList = bufferList st ++ [(buffer st, bufferOfs st)], bufferOfs = 0})++-- | Return a pointer to the beginning of the first code buffer, which+-- is normally the entry point to the generated code.+getEntryPoint :: CodeGen e s (Ptr Word8)+getEntryPoint =+    CodeGen (\ env (ustate, state) -> +      return $ ((ustate, state), Right (firstBuffer state)))++-- | Return the current offset in the code buffer, e.g. the offset+-- at which the next instruction will be emitted.+getCodeOffset :: CodeGen e s Int+getCodeOffset =+    CodeGen (\ env (ustate, state) -> +      return $ ((ustate, state), Right (bufferOfs state)))++-- | Set the user state to the given value. +setState :: s -> CodeGen e s ()+setState st =+    CodeGen (\ env (_, state) -> +      return $ ((st, state), Right ()))++-- | Return the current user state.+getState :: CodeGen e s s+getState =+    CodeGen (\ env (ustate, state) -> +      return $ ((ustate, state), Right (ustate)))++-- | Return the current user environment.+getEnv :: CodeGen e s e+getEnv =+    CodeGen (\ (uenv, env) state -> +      return $ (state, Right uenv))++-- | Set the environment to the given value and execute the given+-- code generation in this environment.+withEnv :: e -> CodeGen e s r -> CodeGen e s r+withEnv e (CodeGen cg) =+    CodeGen (\ (_, env) state ->+      cg (e, env) state)++-- | Set the user state to the given value. +setInternalState :: CodeGenState -> CodeGen e s ()+setInternalState st =+    CodeGen (\ env (ustate, _) -> +      return $ ((ustate, st), Right ()))++-- | Return the current user state.+getInternalState :: CodeGen e s CodeGenState+getInternalState =+    CodeGen (\ env (ustate, state) -> +      return $ ((ustate, state), Right (state)))++-- | Return the pointer to the start of the code buffer.+-- {-# INLINE getBasePtr #-}+getBasePtr :: CodeGen e s (Ptr Word8)+getBasePtr =+    CodeGen (\ env (ustate, state) -> +      return $ ((ustate, state), Right (buffer state)))++-- | Return a list of all code buffers and their respective size +-- (i.e., actually used space for code, not allocated size).+getCodeBufferList :: CodeGen e s [(Ptr Word8, Int)]+getCodeBufferList = do st <- getInternalState+                       return $ bufferList st ++ [(buffer st, bufferOfs st)]++-- | Generate a new label to be used with the label operations+-- 'emitRelocInfo', 'emitFixup' and 'defineLabel'.+newLabel :: CodeGen e s Label+newLabel =+    do state <- getInternalState+       let lab = nextLabel state+       setInternalState state{nextLabel = lab + 1}+       return (Label lab)++-- | Generate a new label and define it at once+setLabel :: CodeGen e s Label+setLabel =+    do l <- newLabel+       defineLabel l+       return l++-- | Emit a relocation entry for the given offset, relocation kind +-- and target address.+emitRelocInfo :: Int -> RelocKind -> FunPtr a -> CodeGen e s ()+emitRelocInfo ofs kind addr = +    CodeGen (\ env (ustate, state) -> +      do let newState = state{relocEntries =+                              Reloc{offset = ofs, +                                    kind = kind,+                                    address = castFunPtr addr} : +                              (relocEntries state)}+         return $ ((ustate, newState), Right ()))++-- | Emit a byte value to the code buffer. +-- {-# INLINE emit8 #-}+emit8 :: Word8 -> CodeGen e s ()+emit8 op = +    CodeGen (\ env (ustate, state) -> +      do let buf = buffer state+             ptr = bufferOfs state+         pokeByteOff buf ptr op+         return $ ((ustate, state{bufferOfs = ptr + 1}), Right ()))++-- | Store a byte value at the given offset into the code buffer.+-- {-# INLINE emit8At #-}+emit8At :: Int -> Word8 -> CodeGen e s ()+emit8At pos op = +    CodeGen (\ env (ustate, state) -> +      do let buf = buffer state+         pokeByteOff buf pos op+         return $ ((ustate, state), Right ()))++-- | Return the byte value at the given offset in the code buffer.+-- {-# INLINE peek8At #-}+peek8At :: Int -> CodeGen e s Word8+peek8At pos =+    CodeGen (\ env (ustate, state) -> +      do let buf = buffer state+         b <- peekByteOff buf pos+         return $ ((ustate, state), Right b))++-- | Like 'emit8', but for a 32-bit value.+-- {-# INLINE emit32 #-}+emit32 :: Word32 -> CodeGen e s ()+emit32 op = +    CodeGen (\ env (ustate, state) -> +      do let buf = buffer state+             ptr = bufferOfs state+         pokeByteOff buf ptr op+         return $ ((ustate, state{bufferOfs = ptr + 4}), Right ()))++-- | Like 'emit8At', but for a 32-bit value.+-- {-# INLINE emit32At #-}+emit32At :: Int -> Word32 -> CodeGen e s ()+emit32At pos op = +    CodeGen (\ env (ustate, state) -> +      do let buf = buffer state+         pokeByteOff buf pos op+         return $ ((ustate, state), Right ()))++-- | Emit a label at the current offset in the code buffer.  All+-- references to the label will be relocated to this offset.+defineLabel :: Label -> CodeGen e s ()+defineLabel (Label lab) = +    do state <- getInternalState+       case Map.lookup lab (pendingFixups state) of+         Just fixups -> do mapM_ (performFixup (buffer state) (bufferOfs state)) fixups+                           setInternalState state{pendingFixups = Map.delete lab (pendingFixups state)}+         Nothing -> return ()+       state <- getInternalState+       setInternalState state{definedLabels = Map.insert lab (buffer state, bufferOfs state) (definedLabels state)}++performFixup :: Ptr Word8 -> Int -> FixupEntry -> CodeGen e s ()+performFixup labBuf labOfs (FixupEntry{fueBuffer = buf, fueOfs = ofs, fueKind = kind}) =+    do let diff = (labBuf `plusPtr` labOfs) `minusPtr` (buf `plusPtr` (ofs + 4))+       liftIO $ case kind of+                  Fixup8 -> pokeByteOff buf ofs (fromIntegral diff :: Word8)+                  Fixup16 -> pokeByteOff buf ofs (fromIntegral diff :: Word16)+                  Fixup32 -> pokeByteOff buf ofs (fromIntegral diff :: Word32)+                  Fixup32Absolute -> pokeByteOff buf ofs (fromIntegral (ptrToWordPtr (labBuf `plusPtr` labOfs)) :: Word32)+       return ()+++(@@) :: Label -> CodeGen e s a -> CodeGen e s a+(@@) lab gen = do defineLabel lab+                  gen++-- | Emit a fixup entry for the given label at the current offset in+-- the code buffer (unless the label is already defined).+-- The instruction at this offset will+-- be patched to target the address associated with this label when+-- it is defined later.+emitFixup :: Label -> Int -> FixupKind -> CodeGen e s ()+emitFixup (Label lab) ofs kind = +    do state <- getInternalState +       let base = buffer state+           ptr = bufferOfs state+       case Map.lookup lab (definedLabels state) of+         Just (labBuf, labOfs) -> performFixup labBuf labOfs (FixupEntry{fueBuffer = base,+                                                                         fueOfs = ptr + ofs,+                                                                         fueKind = kind})+         Nothing -> setInternalState state{pendingFixups = Map.insertWith (++) lab [FixupEntry{fueBuffer = base,+                                                                                          fueOfs = ptr + ofs,+                                                                                          fueKind = kind}]+                                                                                          (pendingFixups state)}++-- | Return the address of a label, fail if the label is not yet defined.+labelAddress :: Label -> CodeGen e s (Ptr a)+labelAddress (Label lab) = do+  state <- getInternalState+  case Map.lookup lab (definedLabels state) of+    Just (labBuf, labOfs) -> return $ plusPtr labBuf labOfs+    Nothing -> fail $ "Label " ++ show lab ++ " not yet defined"+++-- | Disassemble all code buffers.+disassemble :: CodeGen e s [Dis.Instruction]+disassemble = do+  s <- getInternalState+  let buffers = bufferList s+  r <- mapM (\ (buffer, length) -> do+             r <- liftIO $ Dis.disassembleBlock buffer length+             case r of+                    Left err -> cgFail $ show err+                    Right instr -> return instr+            ) $ buffers ++ [(buffer s, bufferOfs s)]+  return $ concat r++#ifndef __HADDOCK__++callDecl :: String -> Q Type -> Q [Dec]+callDecl ns qt =  do+    t0 <- qt+    let (tvars, cxt, t) = case t0 of+                         ForallT vs c t -> (vs, c, t)+                         _ -> ([], [], t0)+    let name = mkName ns+    let funptr = AppT (ConT $ mkName "FunPtr") t+    let ioresult = addIO t+    let ty = AppT (AppT ArrowT funptr) ioresult+    dynName <- newName "conv"+    let dyn = ForeignD $ ImportF CCall Safe "dynamic" dynName $ ForallT tvars cxt ty+    vs <- mkArgs t+    cbody <- [| CodeGen (\env (ustate, state) ->+                        do let code = firstBuffer state+                           res <- liftIO $ $(do+                                             c <- newName "c"+                                             cast <- [|castPtrToFunPtr|]+                                             let f = AppE (VarE dynName)+                                                          (AppE cast+                                                                (VarE c))+                                             return $ LamE [VarP c] $ foldl AppE f $ map VarE vs+                                            ) code+                           return $ ((ustate, state), Right res))|]+    let call = ValD (VarP name) (NormalB $ LamE (map VarP vs) cbody) []+    return [ dyn, call ]++mkArgs (AppT (AppT ArrowT _from) to) = do+  v  <- newName "v"+  vs <- mkArgs to+  return $ v : vs+mkArgs _ = return []++addIO (AppT t@(AppT ArrowT _from) to) = AppT t $ addIO to+addIO t = AppT (ConT $ mkName "IO") t++#else++-- | Declare a stub function to call the code buffer. Arguments are the name+-- of the generated function, and the type the code buffer is supposed to have.+-- The type argument can be given using the [t| ... |] notation of Template Haskell.+-- Allowed types are the legal types for FFI functions.+callDecl :: String -> Q Type -> Q [Dec]++#endif
+ Harpy/X86Assembler.lhs view
@@ -0,0 +1,2906 @@++> --------------------------------------------------------------------------+> -- |+> -- Module      :  X86Assembler+> -- Copyright   :  (c) 2006-2007 Martin Grabmueller and Dirk Kleeblatt+> -- License     :  GPL+> -- +> -- Maintainer  :  {magr,klee}@cs.tu-berlin.de+> -- Stability   :  provisional+> -- Portability :  non-portable+> --+> -- A type class based layer on top of X86CodeGen+> -- which determines the addressing modes from the types of the+> -- operands.+> --------------------------------------------------------------------------+++This module provides simple assembler facilities.++> module Harpy.X86Assembler where++> import Harpy.X86CodeGen+> import Harpy.CodeGenMonad+> import Data.Word+> import Foreign.Ptr++> import qualified Text.PrettyPrint.HughesPJ as PP+++address modes used in this module:++Word8/16/32	   	     immediate values+Reg8/16/32	             register+Addr Word32		     absolut+Ind Reg32		     register indirect+(Disp, Reg32)		     register indirect with displacement+(Reg32, Reg32, Scale)	     (base, index, scale), effective address is (base + index * scale)+(Disp, Reg32, Scale)	     (disp, index, scale), effective address is (disp + index * scale)+(Disp, Reg32, Reg32, Scale)  (base, index, scale) + displacement (only ebp is allowed as base register)+Label                        not-yet-specified label+ +> onlyEbp = failCodeGen (PP.text "only epb is allowed as base register for disp/base/index/scale addressing")+> onlyCl  = failCodeGen (PP.text "only cl is allowed as shift count")+++x86 Registers++> newtype Reg8 = Reg8 Word8+> al, cl, dl, bl, ah, ch, dh, bh :: Reg8++> al = Reg8 0+> cl = Reg8 1+> dl = Reg8 2+> bl = Reg8 3+> ah = Reg8 4+> ch = Reg8 5+> dh = Reg8 6+> bh = Reg8 7++> newtype Reg16 = Reg16 Word8+> ax, cx, dx, bx, sp, bp, si, di :: Reg16++> ax = Reg16 0+> cx = Reg16 1+> dx = Reg16 2+> bx = Reg16 3+> sp = Reg16 4+> bp = Reg16 5+> si = Reg16 6+> di = Reg16 7++> newtype Reg32 = Reg32 Word8 deriving Eq+> eax, ecx, edx, ebx, esp, ebp, esi, edi :: Reg32++> eax = Reg32 0+> ecx = Reg32 1+> edx = Reg32 2+> ebx = Reg32 3+> esp = Reg32 4+> ebp = Reg32 5+> esi = Reg32 6+> edi = Reg32 7++-- TODO: instances for other registers++> instance Show Reg32 where+>  show (Reg32 0) = "eax"+>  show (Reg32 1) = "ecx"+>  show (Reg32 2) = "edx"+>  show (Reg32 3) = "ebx"+>  show (Reg32 4) = "esp"+>  show (Reg32 5) = "ebp"+>  show (Reg32 6) = "esi"+>  show (Reg32 7) = "edi"++memory addresses++> newtype Addr  = Addr Word32+> newtype Ind   = Ind Reg32+> newtype Disp  = Disp Word32++> data    Scale = S1 | S2 | S4 | S8++> scaleToShift :: Scale -> Word8+> scaleToShift S1 = 0+> scaleToShift S2 = 1+> scaleToShift S4 = 2+> scaleToShift S8 = 3+++int 3++> breakpoint = x86_breakpoint+++clear direction flag++> cld = x86_cld+++store string++> stosb = x86_stosb+> stosl = x86_stosl+> stosd = x86_stosd+++move string++> movsb = x86_movsb+> movsl = x86_movsl+> movsd = x86_movsd+++read time stamp counter++> rdtsc = x86_rdtsc+++compare and exchange++> class Cmpxchg a b where+>   cmpxchg :: a -> b -> CodeGen e s ()++> instance Cmpxchg Reg32 Reg32 where+>   cmpxchg (Reg32 dest) (Reg32 source) = x86_cmpxchg_reg_reg dest source+>+> instance Cmpxchg Addr Reg32 where+>   cmpxchg (Addr dest) (Reg32 source) = x86_cmpxchg_mem_reg dest source+>+> instance Cmpxchg (Disp, Reg32) Reg32 where+>   cmpxchg (Disp disp, Reg32 dest) (Reg32 source) = x86_cmpxchg_membase_reg dest disp source+>+> instance Cmpxchg Ind Reg32 where+>   cmpxchg (Ind (Reg32 dest)) (Reg32 source) = x86_cmpxchg_membase_reg dest 0 source++++exchange memory/register with register++> class Xchg a b where+>   xchg :: a -> b -> CodeGen e s ()++> instance Xchg Reg8 Reg8 where+>   xchg (Reg8 dest) (Reg8 source) = x86_xchg_reg_reg dest source 1+>+> instance Xchg Reg32 Reg32 where+>   xchg (Reg32 dest) (Reg32 source) = x86_xchg_reg_reg dest source 4+>+> instance Xchg Addr Reg8 where+>   xchg (Addr dest) (Reg8 source) = x86_xchg_mem_reg dest source 1+>+> instance Xchg Addr Reg32 where+>   xchg (Addr dest) (Reg32 source) = x86_xchg_mem_reg dest source 4+>+> instance Xchg (Disp, Reg32) Reg8 where+>   xchg (Disp disp, Reg32 dest) (Reg8 source) = x86_xchg_membase_reg dest disp source 1+>+> instance Xchg Ind Reg8 where+>   xchg (Ind (Reg32 dest)) (Reg8 source) = x86_xchg_membase_reg dest 0 source 1+>+> instance Xchg (Disp, Reg32) Reg32 where+>   xchg (Disp disp, Reg32 dest) (Reg32 source) = x86_xchg_membase_reg dest disp source 4+>+> instance Xchg Ind Reg32 where+>   xchg (Ind (Reg32 dest)) (Reg32 source) = x86_xchg_membase_reg dest 0 source 4+++exchange and add++> class Xadd a b where+>   xadd :: a -> b -> CodeGen e s ()++> instance Xadd Reg8 Reg8 where+>   xadd (Reg8 dest) (Reg8 source) = x86_xadd_reg_reg dest source 1+>+> instance Xadd Reg32 Reg32 where+>   xadd (Reg32 dest) (Reg32 source) = x86_xadd_reg_reg dest source 4+>+> instance Xadd Addr Reg8 where+>   xadd (Addr dest) (Reg8 source) = x86_xadd_mem_reg dest source 1+>+> instance Xadd Addr Reg32 where+>   xadd (Addr dest) (Reg32 source) = x86_xadd_mem_reg dest source 4+>+> instance Xadd (Disp, Reg32) Reg8 where+>   xadd (Disp disp, Reg32 dest) (Reg8 source) = x86_xadd_membase_reg dest disp source 1+>+> instance Xadd Ind Reg8 where+>   xadd (Ind (Reg32 dest)) (Reg8 source) = x86_xadd_membase_reg dest 0 source 1+>+> instance Xadd (Disp, Reg32) Reg32 where+>   xadd (Disp disp, Reg32 dest) (Reg32 source) =  x86_xadd_membase_reg dest disp source 4+>+> instance Xadd Ind Reg32 where+>   xadd (Ind (Reg32 dest)) (Reg32 source) =  x86_xadd_membase_reg dest 0 source 4+++Increment by 1++> class Inc a where+>   inc :: a -> CodeGen e s ()++> instance Inc Addr where+>   inc (Addr dest) = x86_inc_mem dest+>+> instance Inc (Disp, Reg32) where+>   inc (Disp disp, Reg32 dest) = x86_inc_membase dest disp+>+> instance Inc Ind where+>   inc (Ind (Reg32 dest)) = x86_inc_membase dest 0+>+> instance Inc Reg32 where+>   inc (Reg32 dest) = x86_inc_reg dest+++Decrement by 1++> class Dec a where+>   dec :: a -> CodeGen e s ()++> instance Dec Addr where+>   dec (Addr dest) = x86_dec_mem dest+>+> instance Dec (Disp, Reg32) where+>   dec (Disp disp, Reg32 dest) = x86_dec_membase dest disp+>+> instance Dec Ind where+>   dec (Ind (Reg32 dest)) = x86_dec_membase dest 0+>+> instance Dec Reg32 where+>   dec (Reg32 dest) = x86_dec_reg dest+++One's complement negation++> class Not a where+>   not :: a -> CodeGen e s ()++> instance Not Addr where+>   not (Addr dest) = x86_not_mem dest+>+> instance Not (Disp, Reg32) where+>   not (Disp disp, Reg32 dest) = x86_not_membase dest disp+>+> instance Not Ind where+>   not (Ind (Reg32 dest)) = x86_not_membase dest 0+>+> instance Not Reg32 where+>   not (Reg32 dest) = x86_not_reg dest+++Two's complement negation++> class Neg a where+>   neg :: a -> CodeGen e s ()++> instance Neg Addr where+>   neg (Addr dest) = x86_neg_mem dest+>+> instance Neg (Disp, Reg32) where+>   neg (Disp disp, Reg32 dest) = x86_neg_membase dest disp+>+> instance Neg Ind where+>   neg (Ind (Reg32 dest)) = x86_neg_membase dest 0+>+> instance Neg Reg32 where+>   neg (Reg32 dest) = x86_neg_reg dest+++No operation++> nop = x86_nop+++ALU operations++Calling "x86_alu_reg8_reg8 _ _ _ *False* *False*" is a little bit hackish: the last two+arguments are set to True for the "high byte registers" ah, bh, ch and dh.+x86_reg8_emit then sets the 3rd bit in the register number. This bit is set in our+encoding anyway to the right value, so we simply skip this part.++> class Add a b where+>   add :: a -> b -> CodeGen e s ()++> instance Add Reg32 Word32 where+>   add (Reg32 dest) imm = x86_alu_reg_imm x86_add dest (fromIntegral imm)+>+> instance Add Addr Word32 where+>   add (Addr dest) imm = x86_alu_mem_imm x86_add dest (fromIntegral imm)+>+> instance Add (Disp, Reg32) Word32 where+>   add (Disp disp, Reg32 dest) imm = x86_alu_membase_imm x86_add dest disp (fromIntegral imm)+>+> instance Add Ind Word32 where+>   add (Ind (Reg32 dest)) imm = x86_alu_membase_imm x86_add dest 0 (fromIntegral imm)+>+> instance Add (Disp, Reg32) Word8 where+>   add (Disp disp, Reg32 dest) imm = x86_alu_membase8_imm x86_add dest disp (fromIntegral imm)+>+> instance Add Ind Word8 where+>   add (Ind (Reg32 dest)) imm = x86_alu_membase8_imm x86_add dest 0 (fromIntegral imm)+>+> instance Add Addr Reg32 where+>   add (Addr dest) (Reg32 source) = x86_alu_mem_reg x86_add dest source+>+> instance Add (Disp, Reg32) Reg32 where+>   add (Disp disp, Reg32 dest) (Reg32 source) = x86_alu_membase_reg x86_add dest disp source+>+> instance Add Ind Reg32 where+>   add (Ind (Reg32 dest)) (Reg32 source) = x86_alu_membase_reg x86_add dest 0 source+>+> instance Add Reg32 Reg32 where+>   add (Reg32 dest) (Reg32 source) = x86_alu_reg_reg x86_add dest source+>+> instance Add Reg8 Reg8 where+>   add (Reg8 dest) (Reg8 source) = x86_alu_reg8_reg8 x86_add dest source False False+>+> instance Add Reg32 Addr where+>   add (Reg32 dest) (Addr source) = x86_alu_reg_mem x86_add dest source+>+> instance Add Reg32 (Disp, Reg32) where+>   add (Reg32 dest) (Disp disp, Reg32 source) = x86_alu_reg_membase x86_add dest source disp+>+> instance Add Reg32 Ind where+>   add (Reg32 dest) (Ind (Reg32 source)) = x86_alu_reg_membase x86_add dest source 0+++> class Or a b where+>   or :: a -> b -> CodeGen e s ()++> instance Or Reg32 Word32 where+>   or (Reg32 dest) imm = x86_alu_reg_imm x86_or dest (fromIntegral imm)+>+> instance Or Addr Word32 where+>   or (Addr dest) imm = x86_alu_mem_imm x86_or dest (fromIntegral imm)+>+> instance Or (Disp, Reg32) Word32 where+>   or (Disp disp, Reg32 dest) imm = x86_alu_membase_imm x86_or dest disp (fromIntegral imm)+>+> instance Or Ind Word32 where+>   or (Ind (Reg32 dest)) imm = x86_alu_membase_imm x86_or dest 0 (fromIntegral imm)+>+> instance Or (Disp, Reg32) Word8 where+>   or (Disp disp, Reg32 dest) imm = x86_alu_membase8_imm x86_or dest disp (fromIntegral imm)+>+> instance Or Ind Word8 where+>   or (Ind (Reg32 dest)) imm = x86_alu_membase8_imm x86_or dest 0 (fromIntegral imm)+>+> instance Or Addr Reg32 where+>   or (Addr dest) (Reg32 source) = x86_alu_mem_reg x86_or dest source+>+> instance Or (Disp, Reg32) Reg32 where+>   or (Disp disp, Reg32 dest) (Reg32 source) = x86_alu_membase_reg x86_or dest disp source+>+> instance Or Ind Reg32 where+>   or (Ind (Reg32 dest)) (Reg32 source) = x86_alu_membase_reg x86_or dest 0 source+>+> instance Or Reg32 Reg32 where+>   or (Reg32 dest) (Reg32 source) = x86_alu_reg_reg x86_or dest source+>+> instance Or Reg8 Reg8 where+>   or (Reg8 dest) (Reg8 source) = x86_alu_reg8_reg8 x86_or dest source False False+>+> instance Or Reg32 Addr where+>   or (Reg32 dest) (Addr source) = x86_alu_reg_mem x86_or dest source+>+> instance Or Reg32 (Disp, Reg32) where+>   or (Reg32 dest) (Disp disp, Reg32 source) = x86_alu_reg_membase x86_or dest source disp+>+> instance Or Reg32 Ind where+>   or (Reg32 dest) (Ind (Reg32 source)) = x86_alu_reg_membase x86_or dest source 0+++> class Adc a b where+>   adc :: a -> b -> CodeGen e s ()++> instance Adc Reg32 Word32 where+>   adc (Reg32 dest) imm = x86_alu_reg_imm x86_adc dest (fromIntegral imm)+>+> instance Adc Addr Word32 where+>   adc (Addr dest) imm = x86_alu_mem_imm x86_adc dest (fromIntegral imm)+>+> instance Adc (Disp, Reg32) Word32 where+>   adc (Disp disp, Reg32 dest) imm = x86_alu_membase_imm x86_adc dest disp (fromIntegral imm)+>+> instance Adc Ind Word32 where+>   adc (Ind (Reg32 dest)) imm = x86_alu_membase_imm x86_adc dest 0 (fromIntegral imm)+>+> instance Adc (Disp, Reg32) Word8 where+>   adc (Disp disp, Reg32 dest) imm = x86_alu_membase8_imm x86_adc dest disp (fromIntegral imm)+>+> instance Adc Ind Word8 where+>   adc (Ind (Reg32 dest)) imm = x86_alu_membase8_imm x86_adc dest 0 (fromIntegral imm)+>+> instance Adc Addr Reg32 where+>   adc (Addr dest) (Reg32 source) = x86_alu_mem_reg x86_adc dest source+>+> instance Adc (Disp, Reg32) Reg32 where+>   adc (Disp disp, Reg32 dest) (Reg32 source) = x86_alu_membase_reg x86_adc dest disp source+>+> instance Adc Ind Reg32 where+>   adc (Ind (Reg32 dest)) (Reg32 source) = x86_alu_membase_reg x86_adc dest 0 source+>+> instance Adc Reg32 Reg32 where+>   adc (Reg32 dest) (Reg32 source) = x86_alu_reg_reg x86_adc dest source+>+> instance Adc Reg8 Reg8 where+>   adc (Reg8 dest) (Reg8 source) = x86_alu_reg8_reg8 x86_adc dest source False False+>+> instance Adc Reg32 Addr where+>   adc (Reg32 dest) (Addr source) = x86_alu_reg_mem x86_adc dest source+>+> instance Adc Reg32 (Disp, Reg32) where+>   adc (Reg32 dest) (Disp disp, Reg32 source) = x86_alu_reg_membase x86_adc dest source disp+>+> instance Adc Reg32 Ind where+>   adc (Reg32 dest) (Ind (Reg32 source)) = x86_alu_reg_membase x86_adc dest source 0+++> class Sbb a b where+>   sbb :: a -> b -> CodeGen e s ()++> instance Sbb Reg32 Word32 where+>   sbb (Reg32 dest) imm = x86_alu_reg_imm x86_sbb dest (fromIntegral imm)+>+> instance Sbb Addr Word32 where+>   sbb (Addr dest) imm = x86_alu_mem_imm x86_sbb dest (fromIntegral imm)+>+> instance Sbb (Disp, Reg32) Word32 where+>   sbb (Disp disp, Reg32 dest) imm = x86_alu_membase_imm x86_sbb dest disp (fromIntegral imm)+>+> instance Sbb Ind Word32 where+>   sbb (Ind (Reg32 dest)) imm = x86_alu_membase_imm x86_sbb dest 0 (fromIntegral imm)+>+> instance Sbb (Disp, Reg32) Word8 where+>   sbb (Disp disp, Reg32 dest) imm = x86_alu_membase8_imm x86_sbb dest disp (fromIntegral imm)+>+> instance Sbb Ind Word8 where+>   sbb (Ind (Reg32 dest)) imm = x86_alu_membase8_imm x86_sbb dest 0 (fromIntegral imm)+>+> instance Sbb Addr Reg32 where+>   sbb (Addr dest) (Reg32 source) = x86_alu_mem_reg x86_sbb dest source+>+> instance Sbb (Disp, Reg32) Reg32 where+>   sbb (Disp disp, Reg32 dest) (Reg32 source) = x86_alu_membase_reg x86_sbb dest disp source+>+> instance Sbb Ind Reg32 where+>   sbb (Ind (Reg32 dest)) (Reg32 source) = x86_alu_membase_reg x86_sbb dest 0 source+>+> instance Sbb Reg32 Reg32 where+>   sbb (Reg32 dest) (Reg32 source) = x86_alu_reg_reg x86_sbb dest source+>+> instance Sbb Reg8 Reg8 where+>   sbb (Reg8 dest) (Reg8 source) = x86_alu_reg8_reg8 x86_sbb dest source False False+>+> instance Sbb Reg32 Addr where+>   sbb (Reg32 dest) (Addr source) = x86_alu_reg_mem x86_sbb dest source+>+> instance Sbb Reg32 (Disp, Reg32) where+>   sbb (Reg32 dest) (Disp disp, Reg32 source) = x86_alu_reg_membase x86_sbb dest source disp+>+> instance Sbb Reg32 Ind where+>   sbb (Reg32 dest) (Ind (Reg32 source)) = x86_alu_reg_membase x86_sbb dest source 0+++> class And a b where+>   and :: a -> b -> CodeGen e s ()++> instance And Reg32 Word32 where+>   and (Reg32 dest) imm = x86_alu_reg_imm x86_and dest (fromIntegral imm)+>+> instance And Addr Word32 where+>   and (Addr dest) imm = x86_alu_mem_imm x86_and dest (fromIntegral imm)+>+> instance And (Disp, Reg32) Word32 where+>   and (Disp disp, Reg32 dest) imm = x86_alu_membase_imm x86_and dest disp (fromIntegral imm)+>+> instance And Ind Word32 where+>   and (Ind (Reg32 dest)) imm = x86_alu_membase_imm x86_and dest 0 (fromIntegral imm)+>+> instance And (Disp, Reg32) Word8 where+>   and (Disp disp, Reg32 dest) imm = x86_alu_membase8_imm x86_and dest disp (fromIntegral imm)+>+> instance And Ind Word8 where+>   and (Ind (Reg32 dest)) imm = x86_alu_membase8_imm x86_and dest 0 (fromIntegral imm)+>+> instance And Addr Reg32 where+>   and (Addr dest) (Reg32 source) = x86_alu_mem_reg x86_and dest source+>+> instance And (Disp, Reg32) Reg32 where+>   and (Disp disp, Reg32 dest) (Reg32 source) = x86_alu_membase_reg x86_and dest disp source+>+> instance And Ind Reg32 where+>   and (Ind (Reg32 dest)) (Reg32 source) = x86_alu_membase_reg x86_and dest 0 source+>+> instance And Reg32 Reg32 where+>   and (Reg32 dest) (Reg32 source) = x86_alu_reg_reg x86_and dest source+>+> instance And Reg8 Reg8 where+>   and (Reg8 dest) (Reg8 source) = x86_alu_reg8_reg8 x86_and dest source False False+>+> instance And Reg32 Addr where+>   and (Reg32 dest) (Addr source) = x86_alu_reg_mem x86_and dest source+>+> instance And Reg32 (Disp, Reg32) where+>   and (Reg32 dest) (Disp disp, Reg32 source) = x86_alu_reg_membase x86_and dest source disp+>+> instance And Reg32 Ind where+>   and (Reg32 dest) (Ind (Reg32 source)) = x86_alu_reg_membase x86_and dest source 0+>++> class Sub a b where+>   sub :: a -> b -> CodeGen e s ()++> instance Sub Reg32 Word32 where+>   sub (Reg32 dest) imm = x86_alu_reg_imm x86_sub dest (fromIntegral imm)+>+> instance Sub Addr Word32 where+>   sub (Addr dest) imm = x86_alu_mem_reg x86_sub dest (fromIntegral imm)+>+> instance Sub (Disp, Reg32) Word32 where+>   sub (Disp disp, Reg32 dest) imm = x86_alu_membase_imm x86_sub dest disp (fromIntegral imm)+>+> instance Sub Ind Word32 where+>   sub (Ind (Reg32 dest)) imm = x86_alu_membase_imm x86_sub dest 0 (fromIntegral imm)+>+> instance Sub (Disp, Reg32) Word8 where+>   sub (Disp disp, Reg32 dest) imm = x86_alu_membase8_imm x86_sub dest disp (fromIntegral imm)+>+> instance Sub Ind Word8 where+>   sub (Ind (Reg32 dest)) imm = x86_alu_membase8_imm x86_sub dest 0 (fromIntegral imm)+>+> instance Sub Addr Reg32 where+>   sub (Addr dest) (Reg32 source) = x86_alu_mem_reg x86_sub dest source+>+> instance Sub (Disp, Reg32) Reg32 where+>   sub (Disp disp, Reg32 dest) (Reg32 source) = x86_alu_membase_reg x86_sub dest disp source+>+> instance Sub Ind Reg32 where+>   sub (Ind (Reg32 dest)) (Reg32 source) = x86_alu_membase_reg x86_sub dest 0 source+>+> instance Sub Reg32 Reg32 where+>   sub (Reg32 dest) (Reg32 source) = x86_alu_reg_reg x86_sub dest source+>+> instance Sub Reg8 Reg8 where+>   sub (Reg8 dest) (Reg8 source) = x86_alu_reg8_reg8 x86_sub dest source False False+>+> instance Sub Reg32 Addr where+>   sub (Reg32 dest) (Addr source) = x86_alu_reg_mem x86_sub dest source+>+> instance Sub Reg32 (Disp, Reg32) where+>   sub (Reg32 dest) (Disp disp, Reg32 source) = x86_alu_reg_membase x86_sub dest source disp+>+> instance Sub Reg32 Ind where+>   sub (Reg32 dest) (Ind (Reg32 source)) = x86_alu_reg_membase x86_sub dest source 0+++> class Xor a b where+>   xor :: a -> b -> CodeGen e s ()++> instance Xor Reg32 Word32 where+>   xor (Reg32 dest) imm = x86_alu_reg_imm x86_xor dest (fromIntegral imm)+>+> instance Xor Addr Word32 where+>   xor (Addr dest) imm = x86_alu_mem_imm x86_xor dest (fromIntegral imm)+>+> instance Xor (Disp, Reg32) Word32 where+>   xor (Disp disp, Reg32 dest) imm = x86_alu_membase_imm x86_xor dest disp (fromIntegral imm)+>+> instance Xor Ind Word32 where+>   xor (Ind (Reg32 dest)) imm = x86_alu_membase_imm x86_xor dest 0 (fromIntegral imm)+>+> instance Xor (Disp, Reg32) Word8 where+>   xor (Disp disp, Reg32 dest) imm = x86_alu_membase8_imm x86_xor dest disp (fromIntegral imm)+>+> instance Xor Ind Word8 where+>   xor (Ind (Reg32 dest)) imm = x86_alu_membase8_imm x86_xor dest 0 (fromIntegral imm)+>+> instance Xor Addr Reg32 where+>   xor (Addr dest) (Reg32 source) = x86_alu_mem_reg x86_xor dest source+>+> instance Xor (Disp, Reg32) Reg32 where+>   xor (Disp disp, Reg32 dest) (Reg32 source) = x86_alu_membase_reg x86_xor dest disp source+>+> instance Xor Ind Reg32 where+>   xor (Ind (Reg32 dest)) (Reg32 source) = x86_alu_membase_reg x86_xor dest 0 source+>+> instance Xor Reg32 Reg32 where+>   xor (Reg32 dest) (Reg32 source) = x86_alu_reg_reg x86_xor dest source+>+> instance Xor Reg8 Reg8 where+>   xor (Reg8 dest) (Reg8 source) = x86_alu_reg8_reg8 x86_xor dest source False False+>+> instance Xor Reg32 Addr where+>   xor (Reg32 dest) (Addr source) = x86_alu_reg_mem x86_xor dest source+>+> instance Xor Reg32 (Disp, Reg32) where+>   xor (Reg32 dest) (Disp disp, Reg32 source) = x86_alu_reg_membase x86_xor dest source disp+>+> instance Xor Reg32 Ind where+>   xor (Reg32 dest) (Ind (Reg32 source)) = x86_alu_reg_membase x86_xor dest source 0+++> class Cmp a b where+>   cmp :: a -> b -> CodeGen e s ()++> instance Cmp Reg32 Word32 where+>   cmp (Reg32 dest) imm = x86_alu_reg_imm x86_cmp dest (fromIntegral imm)+>+> instance Cmp Reg32 Label where+>   cmp (Reg32 dest) lab = do+>       x86_alu_reg_imm x86_cmp dest 0xf0f0f0f0+>       emitFixup lab (-4) Fixup32Absolute+>+> instance Cmp Addr Word32 where+>   cmp (Addr dest) imm = x86_alu_mem_imm x86_cmp dest (fromIntegral imm)+>+> instance Cmp Addr Label where+>   cmp (Addr dest) lab = do+>       x86_alu_mem_imm x86_cmp dest 0xf0f0f0f0+>       emitFixup lab (-4) Fixup32Absolute+>+> instance Cmp (Disp, Reg32) Word32 where+>   cmp (Disp disp, Reg32 dest) imm = x86_alu_membase_imm x86_cmp dest disp (fromIntegral imm)+>+> instance Cmp (Disp, Reg32) Label where+>   cmp (Disp disp, Reg32 dest) lab = do+>                                    x86_alu_membase_imm x86_cmp dest disp 0xf0f0f0f0+>                                    emitFixup lab (-4) Fixup32Absolute+>+> instance Cmp Ind Word32 where+>   cmp (Ind (Reg32 dest)) imm = x86_alu_membase_imm x86_cmp dest 0 (fromIntegral imm)+>+> instance Cmp Ind Label where+>   cmp (Ind (Reg32 dest)) lab = do+>                          x86_alu_membase_imm x86_cmp dest 0 0xf0f0f0f0+>                          emitFixup lab (-4) Fixup32Absolute+>+> instance Cmp (Disp, Reg32) Word8 where+>   cmp (Disp disp, Reg32 dest) imm = x86_alu_membase8_imm x86_cmp dest disp imm+>+> instance Cmp Ind Word8 where+>   cmp (Ind (Reg32 dest)) imm = x86_alu_membase8_imm x86_cmp dest 0 imm+>+> instance Cmp Addr Reg32 where+>   cmp (Addr dest) (Reg32 source) = x86_alu_mem_reg x86_cmp dest source+>+> instance Cmp (Disp, Reg32) Reg32 where+>   cmp (Disp disp, Reg32 dest) (Reg32 source) = x86_alu_membase_reg x86_cmp dest disp source+>+> instance Cmp Ind Reg32 where+>   cmp (Ind (Reg32 dest)) (Reg32 source) = x86_alu_membase_reg x86_cmp dest 0 source+>+> instance Cmp Reg32 Reg32 where+>   cmp (Reg32 dest) (Reg32 source) = x86_alu_reg_reg x86_cmp dest source+>+> instance Cmp Reg8 Reg8 where+>   cmp (Reg8 dest) (Reg8 source) = x86_alu_reg8_reg8 x86_cmp dest source False False+>+> instance Cmp Reg32 Addr where+>   cmp (Reg32 dest) (Addr source) = x86_alu_reg_mem x86_cmp dest source+>+> instance Cmp Reg32 (Disp, Reg32) where+>   cmp (Reg32 dest) (Disp disp, Reg32 source) = x86_alu_reg_membase x86_cmp dest source disp+>+> instance Cmp Reg32 Ind where+>   cmp (Reg32 dest) (Ind (Reg32 source)) = x86_alu_reg_membase x86_cmp dest source 0+++logical compare++> class Test a b where+>   test :: a -> b -> CodeGen e s ()++> instance Test Reg32 Word32 where+>   test (Reg32 dest) imm = x86_test_reg_imm dest imm +>+> instance Test Addr Word32 where+>   test (Addr dest) imm = x86_test_mem_imm dest imm +>+> instance Test (Disp, Reg32) Word32 where+>   test (Disp disp, Reg32 dest) imm = x86_test_membase_imm dest disp imm +>+> instance Test Ind Word32 where+>   test (Ind (Reg32 dest)) imm = x86_test_membase_imm dest 0 imm +>+> instance Test Reg32 Reg32 where+>   test (Reg32 dest) (Reg32 source) = x86_test_reg_reg dest source +>+> instance Test Addr Reg32 where+>   test (Addr dest) (Reg32 source) = x86_test_mem_reg dest source +>+> instance Test (Disp, Reg32) Reg32 where+>   test (Disp disp, Reg32 dest) (Reg32 source) = x86_test_membase_reg dest disp source +>+> instance Test Ind Reg32 where+>   test (Ind (Reg32 dest)) (Reg32 source) = x86_test_membase_reg dest 0 source +++shift and rotate++> class Rol a b where+>   rol :: a -> b -> CodeGen e s ()+>+> instance Rol Reg32 Word8 where+>   rol (Reg32 dest) imm = x86_shift_reg_imm x86_rol dest imm +>+> instance Rol Addr Word8 where+>   rol (Addr dest) imm = x86_shift_mem_imm x86_rol dest imm +>+> instance Rol (Disp, Reg32) Word8 where+>   rol (Disp disp, Reg32 dest) imm = x86_shift_membase_imm x86_rol dest disp imm +>+> instance Rol Ind Word8 where+>   rol (Ind (Reg32 dest)) imm = x86_shift_membase_imm x86_rol dest 0 imm +>+> instance Rol Reg32 Reg8 where+>   rol (Reg32 dest) (Reg8 1) = x86_shift_reg x86_rol dest+>   rol _ _ = onlyCl+>+> instance Rol Addr Reg8 where+>   rol (Addr dest) (Reg8 1) = x86_shift_mem x86_rol dest+>   rol _ _ = onlyCl+>+> instance Rol (Disp, Reg32) Reg8 where+>   rol (Disp disp, Reg32 dest) (Reg8 1) = x86_shift_membase x86_rol dest disp+>+> instance Rol Ind Reg8 where+>   rol (Ind (Reg32 dest)) (Reg8 1) = x86_shift_membase x86_rol dest 0+>   rol _ _ = onlyCl++> class Ror a b where+>   ror :: a -> b -> CodeGen e s ()+>+> instance Ror Reg32 Word8 where+>   ror (Reg32 dest) imm = x86_shift_reg_imm x86_ror dest imm +>+> instance Ror Addr Word8 where+>   ror (Addr dest) imm = x86_shift_mem_imm x86_ror dest imm +>+> instance Ror (Disp, Reg32) Word8 where+>   ror (Disp disp, Reg32 dest) imm = x86_shift_membase_imm x86_ror dest disp imm +>+> instance Ror Ind Word8 where+>   ror (Ind (Reg32 dest)) imm = x86_shift_membase_imm x86_ror dest 0 imm +>+> instance Ror Reg32 Reg8 where+>   ror (Reg32 dest) (Reg8 1) = x86_shift_reg x86_ror dest+>   ror _ _ = onlyCl+>+> instance Ror Addr Reg8 where+>   ror (Addr dest) (Reg8 1) = x86_shift_mem x86_ror dest+>   ror _ _ = onlyCl+>+> instance Ror (Disp, Reg32) Reg8 where+>   ror (Disp disp, Reg32 dest) (Reg8 1) = x86_shift_membase x86_ror dest disp+>+> instance Ror Ind Reg8 where+>   ror (Ind (Reg32 dest)) (Reg8 1) = x86_shift_membase x86_ror dest 0+>   ror _ _ = onlyCl++> class Rcl a b where+>   rcl :: a -> b -> CodeGen e s ()+>+> instance Rcl Reg32 Word8 where+>   rcl (Reg32 dest) imm = x86_shift_reg_imm x86_rcl dest imm +>+> instance Rcl Addr Word8 where+>   rcl (Addr dest) imm = x86_shift_mem_imm x86_rcl dest imm +>+> instance Rcl (Disp, Reg32) Word8 where+>   rcl (Disp disp, Reg32 dest) imm = x86_shift_membase_imm x86_rcl dest disp imm +>+> instance Rcl Ind Word8 where+>   rcl (Ind (Reg32 dest)) imm = x86_shift_membase_imm x86_rcl dest 0 imm +>+> instance Rcl Reg32 Reg8 where+>   rcl (Reg32 dest) (Reg8 1) = x86_shift_reg x86_rcl dest+>   rcl _ _ = onlyCl+>+> instance Rcl Addr Reg8 where+>   rcl (Addr dest) (Reg8 1) = x86_shift_mem x86_rcl dest+>   rcl _ _ = onlyCl+>+> instance Rcl (Disp, Reg32) Reg8 where+>   rcl (Disp disp, Reg32 dest) (Reg8 1) = x86_shift_membase x86_rcl dest disp+>+> instance Rcl Ind Reg8 where+>   rcl (Ind (Reg32 dest)) (Reg8 1) = x86_shift_membase x86_rcl dest 0+>   rcl _ _ = onlyCl++> class Rcr a b where+>   rcr :: a -> b -> CodeGen e s ()+>+> instance Rcr Reg32 Word8 where+>   rcr (Reg32 dest) imm = x86_shift_reg_imm x86_rcr dest imm +>+> instance Rcr Addr Word8 where+>   rcr (Addr dest) imm = x86_shift_mem_imm x86_rcr dest imm +>+> instance Rcr (Disp, Reg32) Word8 where+>   rcr (Disp disp, Reg32 dest) imm = x86_shift_membase_imm x86_rcr dest disp imm +>+> instance Rcr Ind Word8 where+>   rcr (Ind (Reg32 dest)) imm = x86_shift_membase_imm x86_rcr dest 0 imm +>+> instance Rcr Reg32 Reg8 where+>   rcr (Reg32 dest) (Reg8 1) = x86_shift_reg x86_rcr dest+>   rcr _ _ = onlyCl+>+> instance Rcr Addr Reg8 where+>   rcr (Addr dest) (Reg8 1) = x86_shift_mem x86_rcr dest+>   rcr _ _ = onlyCl+>+> instance Rcr (Disp, Reg32) Reg8 where+>   rcr (Disp disp, Reg32 dest) (Reg8 1) = x86_shift_membase x86_rcr dest disp+>+> instance Rcr Ind Reg8 where+>   rcr (Ind (Reg32 dest)) (Reg8 1) = x86_shift_membase x86_rcr dest 0+>   rcr _ _ = onlyCl++> class Shl a b where+>   shl :: a -> b -> CodeGen e s ()+>+> instance Shl Reg32 Word8 where+>   shl (Reg32 dest) imm = x86_shift_reg_imm x86_shl dest imm +>+> instance Shl Addr Word8 where+>   shl (Addr dest) imm = x86_shift_mem_imm x86_shl dest imm +>+> instance Shl (Disp, Reg32) Word8 where+>   shl (Disp disp, Reg32 dest) imm = x86_shift_membase_imm x86_shl dest disp imm +>+> instance Shl Ind Word8 where+>   shl (Ind (Reg32 dest)) imm = x86_shift_membase_imm x86_shl dest 0 imm +>+> instance Shl Reg32 Reg8 where+>   shl (Reg32 dest) (Reg8 1) = x86_shift_reg x86_shl dest+>   shl _ _ = onlyCl+>+> instance Shl Addr Reg8 where+>   shl (Addr dest) (Reg8 1) = x86_shift_mem x86_shl dest+>   shl _ _ = onlyCl+>+> instance Shl (Disp, Reg32) Reg8 where+>   shl (Disp disp, Reg32 dest) (Reg8 1) = x86_shift_membase x86_shl dest disp+>+> instance Shl Ind Reg8 where+>   shl (Ind (Reg32 dest)) (Reg8 1) = x86_shift_membase x86_shl dest 0+>   shl _ _ = onlyCl++> class Shr a b where+>   shr :: a -> b -> CodeGen e s ()+>+> instance Shr Reg32 Word8 where+>   shr (Reg32 dest) imm = x86_shift_reg_imm x86_shr dest imm +>+> instance Shr Addr Word8 where+>   shr (Addr dest) imm = x86_shift_mem_imm x86_shr dest imm +>+> instance Shr (Disp, Reg32) Word8 where+>   shr (Disp disp, Reg32 dest) imm = x86_shift_membase_imm x86_shr dest disp imm +>+> instance Shr Ind Word8 where+>   shr (Ind (Reg32 dest)) imm = x86_shift_membase_imm x86_shr dest 0 imm +>+> instance Shr Reg32 Reg8 where+>   shr (Reg32 dest) (Reg8 1) = x86_shift_reg x86_shr dest+>   shr _ _ = onlyCl+>+> instance Shr Addr Reg8 where+>   shr (Addr dest) (Reg8 1) = x86_shift_mem x86_shr dest+>   shr _ _ = onlyCl+>+> instance Shr (Disp, Reg32) Reg8 where+>   shr (Disp disp, Reg32 dest) (Reg8 1) = x86_shift_membase x86_shr dest disp+>+> instance Shr Ind Reg8 where+>   shr (Ind (Reg32 dest)) (Reg8 1) = x86_shift_membase x86_shr dest 0+>   shr _ _ = onlyCl++> class Sar a b where+>   sar :: a -> b -> CodeGen e s ()+>+> instance Sar Reg32 Word8 where+>   sar (Reg32 dest) imm = x86_shift_reg_imm x86_sar dest imm +>+> instance Sar Addr Word8 where+>   sar (Addr dest) imm = x86_shift_mem_imm x86_sar dest imm +>+> instance Sar (Disp, Reg32) Word8 where+>   sar (Disp disp, Reg32 dest) imm = x86_shift_membase_imm x86_sar dest disp imm +>+> instance Sar Ind Word8 where+>   sar (Ind (Reg32 dest)) imm = x86_shift_membase_imm x86_sar dest 0 imm +>+> instance Sar Reg32 Reg8 where+>   sar (Reg32 dest) (Reg8 1) = x86_shift_reg x86_sar dest+>   sar _ _ = onlyCl+>+> instance Sar Addr Reg8 where+>   sar (Addr dest) (Reg8 1) = x86_shift_mem x86_sar dest+>   sar _ _ = onlyCl+>+> instance Sar (Disp, Reg32) Reg8 where+>   sar (Disp disp, Reg32 dest) (Reg8 1) = x86_shift_membase x86_sar dest disp+>+> instance Sar Ind Reg8 where+>   sar (Ind (Reg32 dest)) (Reg8 1) = x86_shift_membase x86_sar dest 0+>   sar _ _ = onlyCl++> class Sal a b where+>   sal :: a -> b -> CodeGen e s ()+>+> instance Sal Reg32 Word8 where+>   sal (Reg32 dest) imm = x86_shift_reg_imm x86_shl dest imm +>+> instance Sal Addr Word8 where+>   sal (Addr dest) imm = x86_shift_mem_imm x86_shl dest imm +>+> instance Sal (Disp, Reg32) Word8 where+>   sal (Disp disp, Reg32 dest) imm = x86_shift_membase_imm x86_shl dest disp imm +>+> instance Sal Ind Word8 where+>   sal (Ind (Reg32 dest)) imm = x86_shift_membase_imm x86_shl dest 0 imm +>+> instance Sal Reg32 Reg8 where+>   sal (Reg32 dest) (Reg8 1) = x86_shift_reg x86_shl dest+>   sal _ _ = onlyCl+>+> instance Sal Addr Reg8 where+>   sal (Addr dest) (Reg8 1) = x86_shift_mem x86_shl dest+>   sal _ _ = onlyCl+>+> instance Sal (Disp, Reg32) Reg8 where+>   sal (Disp disp, Reg32 dest) (Reg8 1) = x86_shift_membase x86_shl dest disp+>+> instance Sal Ind Reg8 where+>   sal (Ind (Reg32 dest)) (Reg8 1) = x86_shift_membase x86_shl dest 0+>   sal _ _ = onlyCl+++double precision shift right++> class Shrd a b c where+>   shrd :: a -> b -> c -> CodeGen e s ()++> instance Shrd Reg32 Reg32 Reg8 where+>   shrd (Reg32 dest) (Reg32 source) (Reg8 1) = x86_shrd_reg dest source+>   shrd _ _ _ = onlyCl+>+> instance Shrd Reg32 Reg32 Word8 where+>   shrd (Reg32 dest) (Reg32 source) imm = x86_shrd_reg_imm dest source imm +++double precision shift left++> class Shld a b c where+>   shld :: a -> b -> c -> CodeGen e s ()++> instance Shld Reg32 Reg32 Reg8 where+>   shld (Reg32 dest) (Reg32 source) (Reg8 1) = x86_shld_reg dest source+>   shld _ _ _ = onlyCl+>+> instance Shld Reg32 Reg32 Word8 where+>   shld (Reg32 dest) (Reg32 source) imm = x86_shld_reg_imm dest source imm +++unsigned multiply++> class Mul a where+>   mul :: a -> CodeGen e s ()++> instance Mul Reg32 where+>   mul (Reg32 arg) = x86_mul_reg arg False+>+> instance Mul Addr where+>   mul (Addr arg) = x86_mul_mem arg False+>+> instance Mul (Disp, Reg32) where+>   mul (Disp disp, Reg32 arg) = x86_mul_membase arg disp False+>+> instance Mul Ind where+>   mul (Ind (Reg32 arg)) = x86_mul_membase arg 0 False+++signed multiply++> data InPlace = InPlace++if a == InPlace then+  b = b * c+else+  a = b * c++> class Imul a b c where+>   imul :: a -> b -> c -> CodeGen e s ()++> instance Imul InPlace Reg32 Reg32 where+>   imul _ (Reg32 dest) (Reg32 source) = x86_imul_reg_reg dest source+>+> instance Imul InPlace Reg32 Addr where+>   imul _ (Reg32 dest) (Addr source) = x86_imul_reg_mem dest source+>+> instance Imul InPlace Reg32 (Disp, Reg32) where+>   imul _ (Reg32 dest) (Disp disp, Reg32 source) = x86_imul_reg_membase dest source disp+>+> instance Imul InPlace Reg32 Ind where+>   imul _ (Reg32 dest) (Ind (Reg32 source)) = x86_imul_reg_membase dest source 0+>+> instance Imul Reg32 Reg32 Word32 where+>   imul (Reg32 dest) (Reg32 source) imm = x86_imul_reg_reg_imm dest source imm +>+> instance Imul Reg32 Addr Word32 where+>   imul (Reg32 dest) (Addr source) imm = x86_imul_reg_mem_imm dest source imm +>+> instance Imul Reg32 (Disp, Reg32) Word32 where+>   imul (Reg32 dest) (Disp disp, Reg32 source) imm = x86_imul_reg_membase_imm dest source disp imm +>+> instance Imul Reg32 Ind Word32 where+>   imul (Reg32 dest) (Ind (Reg32 source)) imm = x86_imul_reg_membase_imm dest source 0 imm +++divide EDX:EAX by rm;+eax = quotient, edx = remainder++unsigned divide++> class Div a where+>   div :: a -> CodeGen e s ()++> instance Div Reg32 where+>   div (Reg32 arg) = x86_div_reg arg False+>+> instance Div Addr where+>   div (Addr arg) = x86_div_mem arg False+>+> instance Div (Disp, Reg32) where+>   div (Disp disp, Reg32 arg) = x86_div_membase arg disp False+>+> instance Div Ind where+>   div (Ind (Reg32 arg)) = x86_div_membase arg 0 False+++signed divide++> class Idiv a where+>   idiv :: a -> CodeGen e s ()++> instance Idiv Reg32 where+>   idiv (Reg32 arg) = x86_div_reg arg True+>+> instance Idiv Addr where+>   idiv (Addr arg) = x86_div_mem arg True+>+> instance Idiv (Disp, Reg32) where+>   idiv (Disp disp, Reg32 arg) = x86_div_membase arg disp True+>+> instance Idiv Ind where+>   idiv (Ind (Reg32 arg)) = x86_div_membase arg 0 True+++"mov" instruction for different sources and destinations++> class Mov a b where+>   mov :: a -> b -> CodeGen e s ()+++> instance Mov Reg8 Reg8 where+>   mov (Reg8 dest) (Reg8 source) = x86_mov_reg_reg dest source 1+>+> instance Mov Reg16 Reg16 where+>   mov (Reg16 dest) (Reg16 source) = x86_mov_reg_reg dest source 2+>+> instance Mov Reg32 Reg32 where+>   mov (Reg32 dest) (Reg32 source) = x86_mov_reg_reg dest source 4+++> instance Mov Reg32 Word32 where+>   mov (Reg32 dest) imm = x86_mov_reg_imm dest (fromIntegral imm)++> instance Mov Reg32 Label where+>   mov (Reg32 dest) lab = do x86_mov_reg_imm dest 0+>                             emitFixup lab (-4) Fixup32Absolute++> instance Mov Addr Word8 where+>   mov (Addr dest) imm = x86_mov_mem_imm dest (fromIntegral imm) 1+>+> instance Mov Addr Word16 where+>   mov (Addr dest) imm = x86_mov_mem_imm dest (fromIntegral imm) 2+>+> instance Mov Addr Word32 where+>   mov (Addr dest) imm = x86_mov_mem_imm dest imm 4++> instance Mov Addr Label where+>   mov (Addr dest) lab = do x86_mov_mem_imm dest 0 4+>                            emitFixup lab (-4) Fixup32Absolute++> instance Mov (Disp, Reg32) Word8 where+>   mov (Disp disp, Reg32 dest) imm = x86_mov_membase_imm dest disp (fromIntegral imm) 1+>+> instance Mov Ind Word8 where+>   mov (Ind (Reg32 dest)) imm = x86_mov_membase_imm dest 0 (fromIntegral imm) 1+>+> instance Mov (Disp, Reg32) Word16 where+>   mov (Disp disp, Reg32 dest) imm = x86_mov_membase_imm dest disp (fromIntegral imm) 2+>+> instance Mov Ind Word16 where+>   mov (Ind (Reg32 dest)) imm = x86_mov_membase_imm dest 0 (fromIntegral imm) 2+>+> instance Mov (Disp, Reg32) Word32 where+>   mov (Disp disp, Reg32 dest) imm = x86_mov_membase_imm dest disp imm 4+>+> instance Mov (Disp, Reg32) Label where+>   mov (Disp disp, Reg32 dest) lab = do x86_mov_membase_imm dest disp 0 4+>                                        emitFixup lab (-4) Fixup32Absolute++> instance Mov Ind Word32 where+>   mov (Ind (Reg32 dest)) imm = x86_mov_membase_imm dest 0 imm 4++> instance Mov Ind Label where+>   mov (Ind (Reg32 dest)) lab = do x86_mov_membase_imm dest 0 0 4+>                                   emitFixup lab (-4) Fixup32Absolute++> instance Mov (Reg32, Reg32, Scale) Word8 where+>   mov (Reg32 base, Reg32 index, scale) imm = x86_mov_memindex_imm base 0 index (scaleToShift scale) (fromIntegral imm) 1+>+> instance Mov (Reg32, Reg32, Scale) Word16 where+>   mov (Reg32 base, Reg32 index, scale) imm = x86_mov_memindex_imm base 0 index (scaleToShift scale) (fromIntegral imm) 2+>+> instance Mov (Reg32, Reg32, Scale) Word32 where+>   mov (Reg32 base, Reg32 index, scale) imm = x86_mov_memindex_imm base 0 index (scaleToShift scale) imm 4++> instance Mov (Reg32, Reg32, Scale) Label where+>   mov (Reg32 base, Reg32 index, scale) lab = do x86_mov_memindex_imm base 0 index (scaleToShift scale) 0 4+>                                                 emitFixup lab (-4) Fixup32Absolute++> instance Mov (Disp, Reg32, Scale) Word8 where+>   mov (Disp disp, Reg32 index, scale) imm = x86_mov_memindex_imm x86_nobasereg disp index (scaleToShift scale) (fromIntegral imm) 1+>+> instance Mov (Disp, Reg32, Scale) Word16 where+>   mov (Disp disp, Reg32 index, scale) imm = x86_mov_memindex_imm x86_nobasereg disp index (scaleToShift scale) (fromIntegral imm) 2+>+> instance Mov (Disp, Reg32, Scale) Word32 where+>   mov (Disp disp, Reg32 index, scale) imm = x86_mov_memindex_imm x86_nobasereg disp index (scaleToShift scale) imm 4++> instance Mov (Disp, Reg32, Scale) Label where+>   mov (Disp disp, Reg32 index, scale) lab = do x86_mov_memindex_imm x86_nobasereg disp index (scaleToShift scale) 0 4+>                                                emitFixup lab (-4) Fixup32Absolute++> instance Mov (Disp, Reg32, Reg32, Scale) Word8 where+>   mov (Disp disp, Reg32 5, Reg32 index, scale) imm = x86_mov_memindex_imm 5 disp index (scaleToShift scale) (fromIntegral imm) 1+>   mov _ _ = onlyEbp+>+> instance Mov (Disp, Reg32, Reg32, Scale) Word16 where+>   mov (Disp disp, Reg32 5, Reg32 index, scale) imm = x86_mov_memindex_imm 5 disp index (scaleToShift scale) (fromIntegral imm) 2+>   mov _ _ = onlyEbp+>+> instance Mov (Disp, Reg32, Reg32, Scale) Word32 where+>   mov (Disp disp, Reg32 5, Reg32 index, scale) imm = x86_mov_memindex_imm 5 disp index (scaleToShift scale) imm 4+>   mov _ _ = onlyEbp++> instance Mov (Disp, Reg32, Reg32, Scale) Label where+>   mov (Disp disp, Reg32 5, Reg32 index, scale) lab = do x86_mov_memindex_imm 5 disp index (scaleToShift scale) 0 4+>                                                         emitFixup lab (-4) Fixup32Absolute+>   mov _ _ = onlyEbp++> instance Mov Addr Reg8 where+>   mov (Addr a) (Reg8 source) = x86_mov_mem_reg a source 1+>+> instance Mov Addr Reg16 where+>   mov (Addr a) (Reg16 source) = x86_mov_mem_reg a source 2+>+> instance Mov Addr Reg32 where+>   mov (Addr a) (Reg32 source) = x86_mov_mem_reg a source 4+>+> instance Mov Reg8 Addr where+>   mov (Reg8 dest) (Addr a) = x86_mov_reg_mem dest a 1+>+> instance Mov Reg16 Addr where+>   mov (Reg16 dest) (Addr a) = x86_mov_reg_mem dest a 2+>+> instance Mov Reg32 Addr where+>   mov (Reg32 dest) (Addr a) = x86_mov_reg_mem dest a 4+++> instance Mov Ind Reg8 where+>   mov (Ind (Reg32 dest)) (Reg8 source) = x86_mov_regp_reg dest source 1+>+> instance Mov Ind Reg16 where+>   mov (Ind (Reg32 dest)) (Reg16 source) = x86_mov_regp_reg dest source 2+>+> instance Mov Ind Reg32 where+>   mov (Ind (Reg32 dest)) (Reg32 source) = x86_mov_regp_reg dest source 4++> instance Mov Reg8 Ind where+>   mov (Reg8 dest) (Ind (Reg32 source)) = x86_mov_reg_regp dest source 1+>+> instance Mov Reg16 Ind where+>   mov (Reg16 dest) (Ind (Reg32 source)) = x86_mov_reg_regp dest source 2+>+> instance Mov Reg32 Ind where+>   mov (Reg32 dest) (Ind (Reg32 source)) = x86_mov_reg_regp dest source 4+++> instance Mov (Disp, Reg32) Reg8 where+>   mov (Disp disp, Reg32 dest) (Reg8 source) = x86_mov_membase_reg dest disp source 1+>+> instance Mov (Disp, Reg32) Reg16 where+>   mov (Disp disp, Reg32 dest) (Reg16 source) = x86_mov_membase_reg dest disp source 2+>+> instance Mov (Disp, Reg32) Reg32 where+>   mov (Disp disp, Reg32 dest) (Reg32 source) = x86_mov_membase_reg dest disp source 4+>+> instance Mov Reg8 (Disp, Reg32) where+>   mov (Reg8 dest) (Disp disp, Reg32 source) = x86_mov_reg_membase dest source disp 1+>+> instance Mov Reg16 (Disp, Reg32) where+>   mov (Reg16 dest) (Disp disp, Reg32 source) = x86_mov_reg_membase dest source disp 2+>+> instance Mov Reg32 (Disp, Reg32) where+>   mov (Reg32 dest) (Disp disp, Reg32 source) = x86_mov_reg_membase dest source disp 4+++> instance Mov (Reg32, Reg32, Scale) Reg8 where+>   mov (Reg32 base, Reg32 index, s) (Reg8 source) = x86_mov_memindex_reg base 0 index (scaleToShift s) source 1+>+> instance Mov (Reg32, Reg32, Scale) Reg16 where+>   mov (Reg32 base, Reg32 index, s) (Reg16 source) = x86_mov_memindex_reg base 0 index (scaleToShift s) source 2+>+> instance Mov (Reg32, Reg32, Scale) Reg32 where+>   mov (Reg32 base, Reg32 index, s) (Reg32 source) = x86_mov_memindex_reg base 0 index (scaleToShift s) source 4+>+> instance Mov Reg8 (Reg32, Reg32, Scale) where+>   mov (Reg8 dest) (Reg32 base, Reg32 index, s) = x86_mov_reg_memindex dest base 0 index (scaleToShift s) 1+>+> instance Mov Reg16 (Reg32, Reg32, Scale) where+>   mov (Reg16 dest) (Reg32 base, Reg32 index, s) = x86_mov_reg_memindex dest base 0 index (scaleToShift s) 2+>+> instance Mov Reg32 (Reg32, Reg32, Scale) where+>   mov (Reg32 dest) (Reg32 base, Reg32 index, s) = x86_mov_reg_memindex dest base 0 index (scaleToShift s) 4+++> instance Mov (Disp, Reg32, Scale) Reg8 where+>   mov (Disp disp, Reg32 index, s) (Reg8 source) = x86_mov_memindex_reg x86_nobasereg disp index (scaleToShift s) source 1+>+> instance Mov (Disp, Reg32, Scale) Reg16 where+>   mov (Disp disp, Reg32 index, s) (Reg16 source) = x86_mov_memindex_reg x86_nobasereg disp index (scaleToShift s) source 2+>+> instance Mov (Disp, Reg32, Scale) Reg32 where+>   mov (Disp disp, Reg32 index, s) (Reg32 source) = x86_mov_memindex_reg x86_nobasereg disp index (scaleToShift s) source 4+>+> instance Mov Reg8 (Disp, Reg32, Scale) where+>   mov (Reg8 dest) (Disp disp, Reg32 index, s) = x86_mov_reg_memindex dest x86_nobasereg disp index (scaleToShift s) 1+>+> instance Mov Reg16 (Disp, Reg32, Scale) where+>   mov (Reg16 dest) (Disp disp, Reg32 index, s) = x86_mov_reg_memindex dest x86_nobasereg disp index (scaleToShift s) 2+>+> instance Mov Reg32 (Disp, Reg32, Scale) where+>   mov (Reg32 dest) (Disp disp, Reg32 index, s) = x86_mov_reg_memindex dest x86_nobasereg disp index (scaleToShift s) 4+++> instance Mov (Disp, Reg32, Reg32, Scale) Reg8 where+>   mov (Disp disp, Reg32 5, Reg32 index, s) (Reg8 source) = x86_mov_memindex_reg 5 disp index (scaleToShift s) source 1+>   mov _ _ = onlyEbp+>+> instance Mov (Disp, Reg32, Reg32, Scale) Reg16 where+>   mov (Disp disp, Reg32 5, Reg32 index, s) (Reg16 source) = x86_mov_memindex_reg 5 disp index (scaleToShift s) source 2+>   mov _ _ = onlyEbp+>+> instance Mov (Disp, Reg32, Reg32, Scale) Reg32 where+>   mov (Disp disp, Reg32 5, Reg32 index, s) (Reg32 source) = x86_mov_memindex_reg 5 disp index (scaleToShift s) source 4+>   mov _ _ = onlyEbp+>+> instance Mov Reg8 (Disp, Reg32, Reg32, Scale) where+>   mov (Reg8 dest) (Disp disp, Reg32 5, Reg32 index, s) = x86_mov_reg_memindex dest 5 disp index (scaleToShift s) 1+>   mov _ _ = onlyEbp+>+> instance Mov Reg16 (Disp, Reg32, Reg32, Scale) where+>   mov (Reg16 dest) (Disp disp, Reg32 5, Reg32 index, s) = x86_mov_reg_memindex dest 5 disp index (scaleToShift s) 2+>   mov _ _ = onlyEbp+>+> instance Mov Reg32 (Disp, Reg32, Reg32, Scale) where+>   mov (Reg32 dest) (Disp disp, Reg32 5, Reg32 index, s) = x86_mov_reg_memindex dest 5 disp index (scaleToShift s) 4+>   mov _ _ = onlyEbp+++move with sign-extension++> class Movsxb a b where+>   movsxb :: a -> b -> CodeGen e s ()++> instance Movsxb Reg32 Reg8 where+>   movsxb (Reg32 dest) (Reg8 source) = x86_widen_reg dest source True False+>+> instance Movsxb Reg32 Addr where+>   movsxb (Reg32 dest) (Addr source) = x86_widen_mem dest source True False+>+> instance Movsxb Reg32 (Disp, Reg32) where+>   movsxb (Reg32 dest) (Disp disp, Reg32 source) = x86_widen_membase dest source disp True False+>+> instance Movsxb Reg32 Ind where+>   movsxb (Reg32 dest) (Ind (Reg32 source)) = x86_widen_membase dest source 0 True False+>+> instance Movsxb Reg32 (Disp, Reg32, Reg32, Scale) where+>   movsxb (Reg32 dest) (Disp disp, Reg32 5, Reg32 index, s) = x86_widen_memindex dest 5 disp index (scaleToShift s) True False+>   movsxb _ _ = onlyEbp+>+> instance Movsxb Reg32 (Disp, Reg32, Scale) where+>   movsxb (Reg32 dest) (Disp disp, Reg32 index, s) = x86_widen_memindex dest x86_nobasereg disp index (scaleToShift s) True False+>+> instance Movsxb Reg32 (Reg32, Reg32, Scale) where+>   movsxb (Reg32 dest) (Reg32 base, Reg32 index, s) = x86_widen_memindex dest base 0 index (scaleToShift s) True False++> class Movsxw a b where+>   movsxw :: a -> b -> CodeGen e s ()++> instance Movsxw Reg32 Reg16 where+>   movsxw (Reg32 dest) (Reg16 source) = x86_widen_reg dest source True True+>+> instance Movsxw Reg32 Addr where+>   movsxw (Reg32 dest) (Addr source) = x86_widen_mem dest source True True+>+> instance Movsxw Reg32 (Disp, Reg32) where+>   movsxw (Reg32 dest) (Disp disp, Reg32 source) = x86_widen_membase dest source disp True True+>+> instance Movsxw Reg32 Ind where+>   movsxw (Reg32 dest) (Ind (Reg32 source)) = x86_widen_membase dest source 0 True True+>+> instance Movsxw Reg32 (Disp, Reg32, Reg32, Scale) where+>   movsxw (Reg32 dest) (Disp disp, Reg32 5, Reg32 index, s) = x86_widen_memindex dest 5 disp index (scaleToShift s) True True+>   movsxw _ _ = onlyEbp+>+> instance Movsxw Reg32 (Disp, Reg32, Scale) where+>   movsxw (Reg32 dest) (Disp disp, Reg32 index, s) = x86_widen_memindex dest x86_nobasereg disp index (scaleToShift s) True True+>+> instance Movsxw Reg32 (Reg32, Reg32, Scale) where+>   movsxw (Reg32 dest) (Reg32 base, Reg32 index, s) = x86_widen_memindex dest base 0 index (scaleToShift s) True True+++move with zero-extension++> class Movzxb a b where+>   movzxb :: a -> b -> CodeGen e s ()++> instance Movzxb Reg32 Reg8 where+>   movzxb (Reg32 dest) (Reg8 source) = x86_widen_reg dest source False False+>+> instance Movzxb Reg32 Addr where+>   movzxb (Reg32 dest) (Addr source) = x86_widen_mem dest source False False+>+> instance Movzxb Reg32 (Disp, Reg32) where+>   movzxb (Reg32 dest) (Disp disp, Reg32 source) = x86_widen_membase dest source disp False False+>+> instance Movzxb Reg32 Ind where+>   movzxb (Reg32 dest) (Ind (Reg32 source)) = x86_widen_membase dest source 0 False False+>+> instance Movzxb Reg32 (Disp, Reg32, Reg32, Scale) where+>   movzxb (Reg32 dest) (Disp disp, Reg32 5, Reg32 index, s) = x86_widen_memindex dest 5 disp index (scaleToShift s) False False+>   movzxb _ _ = onlyEbp+>+> instance Movzxb Reg32 (Disp, Reg32, Scale) where+>   movzxb (Reg32 dest) (Disp disp, Reg32 index, s) = x86_widen_memindex dest x86_nobasereg disp index (scaleToShift s) False False+>+> instance Movzxb Reg32 (Reg32, Reg32, Scale) where+>   movzxb (Reg32 dest) (Reg32 base, Reg32 index, s) = x86_widen_memindex dest base 0 index (scaleToShift s) False False++> class Movzxw a b where+>   movzxw :: a -> b -> CodeGen e s ()++> instance Movzxw Reg32 Reg16 where+>   movzxw (Reg32 dest) (Reg16 source) = x86_widen_reg dest source False True+>+> instance Movzxw Reg32 Addr where+>   movzxw (Reg32 dest) (Addr source) = x86_widen_mem dest source False True+>+> instance Movzxw Reg32 (Disp, Reg32) where+>   movzxw (Reg32 dest) (Disp disp, Reg32 source) = x86_widen_membase dest source disp False True+>+> instance Movzxw Reg32 Ind where+>   movzxw (Reg32 dest) (Ind (Reg32 source)) = x86_widen_membase dest source 0 False True+>+> instance Movzxw Reg32 (Disp, Reg32, Reg32, Scale) where+>   movzxw (Reg32 dest) (Disp disp, Reg32 5, Reg32 index, s) = x86_widen_memindex dest 5 disp index (scaleToShift s) False True+>   movzxw _ _ = onlyEbp+>+> instance Movzxw Reg32 (Disp, Reg32, Scale) where+>   movzxw (Reg32 dest) (Disp disp, Reg32 index, s) = x86_widen_memindex dest x86_nobasereg disp index (scaleToShift s) False True+>+> instance Movzxw Reg32 (Reg32, Reg32, Scale) where+>   movzxw (Reg32 dest) (Reg32 base, Reg32 index, s) = x86_widen_memindex dest base 0 index (scaleToShift s) False True+++load effective address++> class Lea a b where+>   lea :: a -> b -> CodeGen e s ()++> instance Lea Reg32 Addr where+>   lea (Reg32 dest) (Addr source) = x86_lea_mem dest source +>+> instance Lea Reg32 (Disp, Reg32) where+>   lea (Reg32 dest) (Disp disp, Reg32 source) = x86_lea_membase dest source disp +>+> instance Lea Reg32 Ind where+>   lea (Reg32 dest) (Ind (Reg32 source)) = x86_lea_membase dest source 0 +>+> instance Lea Reg32 (Disp, Reg32, Reg32, Scale) where+>   lea (Reg32 dest) (Disp disp, Reg32 5, Reg32 index, s) = x86_lea_memindex dest 5 disp index (scaleToShift s)+>   lea _ _ = onlyEbp+>+> instance Lea Reg32 (Disp, Reg32, Scale) where+>   lea (Reg32 dest) (Disp disp, Reg32 index, s) = x86_lea_memindex dest x86_nobasereg disp index (scaleToShift s)+>+> instance Lea Reg32 (Reg32, Reg32, Scale) where+>   lea (Reg32 dest) (Reg32 base, Reg32 index, s) = x86_lea_memindex dest base 0 index (scaleToShift s)+++convert word to doubleword++> cdq = x86_cdq+++wait for FPU++> wait = x86_wait+++push to stack++> class Push a where+>   push :: a -> CodeGen e s ()++> instance Push Reg32 where+>   push (Reg32 source) = x86_push_reg source +>+> instance Push Ind where+>   push (Ind (Reg32 source)) = x86_push_regp source+>+> instance Push Addr where+>   push (Addr source) = x86_push_mem source +>+> instance Push (Disp, Reg32) where+>   push (Disp disp, Reg32 source) = x86_push_membase source disp +>+> instance Push Word32 where+>   push imm = x86_push_imm imm +>+> instance Push Label where+>   push l = do x86_push_imm_template+>               emitFixup l (-4) Fixup32Absolute+>+> instance Push (Disp, Reg32, Reg32, Scale) where+>   push (Disp disp, Reg32 5, Reg32 index, s) = x86_push_memindex 5 disp index (scaleToShift s)+>   push _ = onlyEbp+>+> instance Push (Disp, Reg32, Scale) where+>   push (Disp disp, Reg32 index, s) = x86_push_memindex x86_nobasereg disp index (scaleToShift s)+>+> instance Push (Reg32, Reg32, Scale) where+>   push (Reg32 base, Reg32 index, s) = x86_push_memindex base 0 index (scaleToShift s)+++pop from stack++> class Pop a where+>   pop :: a -> CodeGen e s ()++> instance Pop Reg32 where+>   pop (Reg32 dest) = x86_pop_reg dest +>+> instance Pop Addr where+>   pop (Addr dest) = x86_pop_mem dest +>+> instance Pop (Disp, Reg32) where+>   pop (Disp disp, Reg32 dest) = x86_pop_membase dest disp +>+> instance Pop Ind where+>   pop (Ind (Reg32 dest)) = x86_pop_membase dest 0 +++push/pop general purpose registers++> pushad = x86_pushad+> popad  = x86_popad+++push/pop EFLAGS++> pushfd = x86_pushfd+> popfd  = x86_popfd+++loop according to ECX couter++> loop   :: Word8 -> CodeGen e s ()+> loop   = x86_loop++> loope  :: Word8 -> CodeGen e s ()+> loope  = x86_loope++> loopne :: Word8 -> CodeGen e s ()+> loopne = x86_loopne+++jump++> class Jmp a where+>   jmp :: a -> CodeGen e s ()++> instance Jmp Word8 where+>   jmp imm = x86_jump8 imm +>+> instance Jmp Word32 where+>   jmp imm = x86_jump32 imm +>+> instance Jmp Reg32 where+>   jmp (Reg32 dest) = x86_jump_reg dest +>+> instance Jmp Addr where+>   jmp (Addr dest) = x86_jump_mem dest +>+> instance Jmp (Disp, Reg32) where+>   jmp (Disp disp, Reg32 dest) = x86_jump_membase dest disp +>+> instance Jmp Ind where+>   jmp (Ind (Reg32 dest)) = x86_jump_membase dest 0 +>+> instance Jmp Label where+>   jmp l = do x86_jump32 0+>              emitFixup l (-4) Fixup32+              +jump on condition code (branch)++> class Ja a where+>   ja :: a -> CodeGen e s ()++> instance Ja Word8 where+>   ja imm = x86_branch8 x86_cc_a imm False+>+> instance Ja Word32 where+>   ja imm = x86_branch32 x86_cc_a imm False++> class Jae a where+>   jae :: a -> CodeGen e s ()++> instance Jae Word8 where+>   jae imm = x86_branch8 x86_cc_ae imm False+>+> instance Jae Word32 where+>   jae imm = x86_branch32 x86_cc_ae imm False+> +> instance Jae Label where+>   jae l = do x86_branch32 x86_cc_ae 0 False+>              emitFixup l (-4) Fixup32++> class Jb a where+>   jb :: a -> CodeGen e s ()++> instance Jb Word8 where+>   jb imm = x86_branch8 x86_cc_b imm False+>+> instance Jb Word32 where+>   jb imm = x86_branch32 x86_cc_b imm False+> +> instance Jb Label where+>   jb l = do x86_branch32 x86_cc_b 0 False+>             emitFixup l (-4) Fixup32++> class Jbe a where+>   jbe :: a -> CodeGen e s ()++> instance Jbe Word8 where+>   jbe imm = x86_branch8 x86_cc_be imm False+>+> instance Jbe Word32 where+>   jbe imm = x86_branch32 x86_cc_be imm False+> +> instance Jbe Label where+>   jbe l = do x86_branch32 x86_cc_be 0 False+>              emitFixup l (-4) Fixup32++> class Jc a where+>   jc :: a -> CodeGen e s ()++> instance Jc Word8 where+>   jc imm = x86_branch8 x86_cc_c imm False+>+> instance Jc Word32 where+>   jc imm = x86_branch32 x86_cc_c imm False+> +> instance Jc Label where+>   jc l = do x86_branch32 x86_cc_c 0 False+>             emitFixup l (-4) Fixup32++> class Je a where+>   je :: a -> CodeGen e s ()++> instance Je Word8 where+>   je imm = x86_branch8 x86_cc_e imm False+>+> instance Je Word32 where+>   je imm = x86_branch32 x86_cc_e imm False+> +> instance Je Label where+>   je l = do x86_branch32 x86_cc_e 0 False+>             emitFixup l (-4) Fixup32++> class Jna a where+>   jna :: a -> CodeGen e s ()++> instance Jna Word8 where+>   jna imm = x86_branch8 x86_cc_na imm False+>+> instance Jna Word32 where+>   jna imm = x86_branch32 x86_cc_na imm False+> +> instance Jna Label where+>   jna l = do x86_branch32 x86_cc_na 0 False+>              emitFixup l (-4) Fixup32++> class Jnae a where+>   jnae :: a -> CodeGen e s ()++> instance Jnae Word8 where+>   jnae imm = x86_branch8 x86_cc_nae imm False+>+> instance Jnae Word32 where+>   jnae imm = x86_branch32 x86_cc_nae imm False+> +> instance Jnae Label where+>   jnae l = do x86_branch32 x86_cc_nae 0 False+>               emitFixup l (-4) Fixup32++> class Jnb a where+>   jnb :: a -> CodeGen e s ()++> instance Jnb Word8 where+>   jnb imm = x86_branch8 x86_cc_nb imm False+>+> instance Jnb Word32 where+>   jnb imm = x86_branch32 x86_cc_nb imm False+> +> instance Jnb Label where+>   jnb l = do x86_branch32 x86_cc_nb 0 False+>              emitFixup l (-4) Fixup32++> class Jnbe a where+>   jnbe :: a -> CodeGen e s ()++> instance Jnbe Word8 where+>   jnbe imm = x86_branch8 x86_cc_nbe imm False+>+> instance Jnbe Word32 where+>   jnbe imm = x86_branch32 x86_cc_nbe imm False+> +> instance Jnbe Label where+>   jnbe l = do x86_branch32 x86_cc_nbe 0 False+>               emitFixup l (-4) Fixup32++> class Jnc a where+>   jnc :: a -> CodeGen e s ()++> instance Jnc Word8 where+>   jnc imm = x86_branch8 x86_cc_nc imm False+>+> instance Jnc Word32 where+>   jnc imm = x86_branch32 x86_cc_nc imm False+> +> instance Jnc Label where+>   jnc l = do x86_branch32 x86_cc_nc 0 False+>              emitFixup l (-4) Fixup32++> class Jne a where+>   jne :: a -> CodeGen e s ()++> instance Jne Word8 where+>   jne imm = x86_branch8 x86_cc_ne imm False+>+> instance Jne Word32 where+>   jne imm = x86_branch32 x86_cc_ne imm False+> +> instance Jne Label where+>   jne l = do x86_branch32 x86_cc_ne 0 False+>              emitFixup l (-4) Fixup32++> class Jnp a where+>   jnp :: a -> CodeGen e s ()++> instance Jnp Word8 where+>   jnp imm = x86_branch8 x86_cc_np imm False+>+> instance Jnp Word32 where+>   jnp imm = x86_branch32 x86_cc_np imm False+> +> instance Jnp Label where+>   jnp l = do x86_branch32 x86_cc_np 0 False+>              emitFixup l (-4) Fixup32++> class Jnz a where+>   jnz :: a -> CodeGen e s ()++> instance Jnz Word8 where+>   jnz imm = x86_branch8 x86_cc_nz imm False+>+> instance Jnz Word32 where+>   jnz imm = x86_branch32 x86_cc_nz imm False+> +> instance Jnz Label where+>   jnz l = do x86_branch32 x86_cc_nz 0 False+>              emitFixup l (-4) Fixup32++> class Jp a where+>   jp :: a -> CodeGen e s ()++> instance Jp Word8 where+>   jp imm = x86_branch8 x86_cc_p imm False+>+> instance Jp Word32 where+>   jp imm = x86_branch32 x86_cc_p imm False+> +> instance Jp Label where+>   jp l = do x86_branch32 x86_cc_p 0 False+>             emitFixup l (-4) Fixup32++> class Jpe a where+>   jpe :: a -> CodeGen e s ()++> instance Jpe Word8 where+>   jpe imm = x86_branch8 x86_cc_pe imm False+>+> instance Jpe Word32 where+>   jpe imm = x86_branch32 x86_cc_pe imm False+> +> instance Jpe Label where+>   jpe l = do x86_branch32 x86_cc_pe 0 False+>              emitFixup l (-4) Fixup32++> class Jpo a where+>   jpo :: a -> CodeGen e s ()++> instance Jpo Word8 where+>   jpo imm = x86_branch8 x86_cc_po imm False+>+> instance Jpo Word32 where+>   jpo imm = x86_branch32 x86_cc_po imm False+> +> instance Jpo Label where+>   jpo l = do x86_branch32 x86_cc_po 0 False+>              emitFixup l (-4) Fixup32++> class Jz a where+>   jz :: a -> CodeGen e s ()++> instance Jz Word8 where+>   jz imm = x86_branch8 x86_cc_z imm False+>+> instance Jz Word32 where+>   jz imm = x86_branch32 x86_cc_z imm False+> +> instance Jz Label where+>   jz l = do x86_branch32 x86_cc_z 0 False+>             emitFixup l (-4) Fixup32++> class Jg a where+>   jg :: a -> CodeGen e s ()++> instance Jg Word8 where+>   jg imm = x86_branch8 x86_cc_gt imm True+>+> instance Jg Word32 where+>   jg imm = x86_branch32 x86_cc_gt imm True+> +> instance Jg Label where+>   jg l = do x86_branch32 x86_cc_gt 0 True+>             emitFixup l (-4) Fixup32++> class Jge a where+>   jge :: a -> CodeGen e s ()++> instance Jge Word8 where+>   jge imm = x86_branch8 x86_cc_ge imm True+>+> instance Jge Word32 where+>   jge imm = x86_branch32 x86_cc_ge imm True+> +> instance Jge Label where+>   jge l = do x86_branch32 x86_cc_ge 0 True+>              emitFixup l (-4) Fixup32++> class Jl a where+>   jl :: a -> CodeGen e s ()++> instance Jl Word8 where+>   jl imm = x86_branch8 x86_cc_lt imm True+>+> instance Jl Word32 where+>   jl imm = x86_branch32 x86_cc_lt imm True+> +> instance Jl Label where+>   jl l = do x86_branch32 x86_cc_lt 0 True+>             emitFixup l (-4) Fixup32++> class Jle a where+>   jle :: a -> CodeGen e s ()++> instance Jle Word8 where+>   jle imm = x86_branch8 x86_cc_le imm True+>+> instance Jle Word32 where+>   jle imm = x86_branch32 x86_cc_le imm True+> +> instance Jle Label where+>   jle l = do x86_branch32 x86_cc_le 0 True+>              emitFixup l (-4) Fixup32++> class Jng a where+>   jng :: a -> CodeGen e s ()++> instance Jng Word8 where+>   jng imm = x86_branch8 x86_cc_le imm True+>+> instance Jng Word32 where+>   jng imm = x86_branch32 x86_cc_le imm True+> +> instance Jng Label where+>   jng l = do x86_branch32 x86_cc_le 0 True+>              emitFixup l (-4) Fixup32++> class Jnge a where+>   jnge :: a -> CodeGen e s ()++> instance Jnge Word8 where+>   jnge imm = x86_branch8 x86_cc_lt imm True+>+> instance Jnge Word32 where+>   jnge imm = x86_branch32 x86_cc_lt imm True+> +> instance Jnge Label where+>   jnge l = do x86_branch32 x86_cc_lt 0 True+>               emitFixup l (-4) Fixup32++> class Jnl a where+>   jnl :: a -> CodeGen e s ()++> instance Jnl Word8 where+>   jnl imm = x86_branch8 x86_cc_ge imm True+>+> instance Jnl Word32 where+>   jnl imm = x86_branch32 x86_cc_ge imm True+> +> instance Jnl Label where+>   jnl l = do x86_branch32 x86_cc_ge 0 True+>              emitFixup l (-4) Fixup32++> class Jnle a where+>   jnle :: a -> CodeGen e s ()++> instance Jnle Word8 where+>   jnle imm = x86_branch8 x86_cc_gt imm True+>+> instance Jnle Word32 where+>   jnle imm = x86_branch32 x86_cc_gt imm True+> +> instance Jnle Label where+>   jnle l = do x86_branch32 x86_cc_gt 0 True+>               emitFixup l (-4) Fixup32++> class Jno a where+>   jno :: a -> CodeGen e s ()++> instance Jno Word8 where+>   jno imm = x86_branch8 x86_cc_no imm True+>+> instance Jno Word32 where+>   jno imm = x86_branch32 x86_cc_no imm True+> +> instance Jno Label where+>   jno l = do x86_branch32 x86_cc_no 0 True+>              emitFixup l (-4) Fixup32++> class Jns a where+>   jns :: a -> CodeGen e s ()++> instance Jns Word8 where+>   jns imm = x86_branch8 x86_cc_ns imm True+>+> instance Jns Word32 where+>   jns imm = x86_branch32 x86_cc_ns imm True+> +> instance Jns Label where+>   jns l = do x86_branch32 x86_cc_ns 0 True+>              emitFixup l (-4) Fixup32++> class Jo a where+>   jo :: a -> CodeGen e s ()++> instance Jo Word8 where+>   jo imm = x86_branch8 x86_cc_o imm True+>+> instance Jo Word32 where+>   jo imm = x86_branch32 x86_cc_o imm True+> +> instance Jo Label where+>   jo l = do x86_branch32 x86_cc_o 0 True+>             emitFixup l (-4) Fixup32++> class Js a where+>   js :: a -> CodeGen e s ()++> instance Js Word8 where+>   js imm = x86_branch8 x86_cc_s imm True+>+> instance Js Word32 where+>   js imm = x86_branch32 x86_cc_s imm True+> +> instance Js Label where+>   js l = do x86_branch32 x86_cc_s 0 True+>             emitFixup l (-4) Fixup32++jump if ecx register is 0++> jecxz :: Word8 -> CodeGen e s ()+> jecxz = x86_jecxz+++set byte on condition code++> class Seta a where+>   seta :: a -> CodeGen e s ()++> instance Seta Reg8 where+>   seta (Reg8 dest) = x86_set_reg x86_cc_a dest False+>+> instance Seta Addr where+>   seta (Addr dest) = x86_set_mem x86_cc_a dest False+>+> instance Seta (Disp, Reg32) where+>   seta (Disp disp, Reg32 dest) = x86_set_membase x86_cc_a dest disp False+>+> instance Seta Ind where+>   seta (Ind (Reg32 dest)) = x86_set_membase x86_cc_a dest 0 False++> class Setae a where+>   setae :: a -> CodeGen e s ()++> instance Setae Reg8 where+>   setae (Reg8 dest) = x86_set_reg x86_cc_ae dest False+>+> instance Setae Addr where+>   setae (Addr dest) = x86_set_mem x86_cc_ae dest False+>+> instance Setae (Disp, Reg32) where+>   setae (Disp disp, Reg32 dest) = x86_set_membase x86_cc_ae dest disp False+>+> instance Setae Ind where+>   setae (Ind (Reg32 dest)) = x86_set_membase x86_cc_ae dest 0 False++> class Setb a where+>   setb :: a -> CodeGen e s ()++> instance Setb Reg8 where+>   setb (Reg8 dest) = x86_set_reg x86_cc_b dest False+>+> instance Setb Addr where+>   setb (Addr dest) = x86_set_mem x86_cc_b dest False+>+> instance Setb (Disp, Reg32) where+>   setb (Disp disp, Reg32 dest) = x86_set_membase x86_cc_b dest disp False+>+> instance Setb Ind where+>   setb (Ind (Reg32 dest)) = x86_set_membase x86_cc_b dest 0 False++> class Setbe a where+>   setbe :: a -> CodeGen e s ()++> instance Setbe Reg8 where+>   setbe (Reg8 dest) = x86_set_reg x86_cc_be dest False+>+> instance Setbe Addr where+>   setbe (Addr dest) = x86_set_mem x86_cc_be dest False+>+> instance Setbe (Disp, Reg32) where+>   setbe (Disp disp, Reg32 dest) = x86_set_membase x86_cc_be dest disp False+>+> instance Setbe Ind where+>   setbe (Ind (Reg32 dest)) = x86_set_membase x86_cc_be dest 0 False++> class Setc a where+>   setc :: a -> CodeGen e s ()++> instance Setc Reg8 where+>   setc (Reg8 dest) = x86_set_reg x86_cc_c dest False+>+> instance Setc Addr where+>   setc (Addr dest) = x86_set_mem x86_cc_c dest False+>+> instance Setc (Disp, Reg32) where+>   setc (Disp disp, Reg32 dest) = x86_set_membase x86_cc_c dest disp False+>+> instance Setc Ind where+>   setc (Ind (Reg32 dest)) = x86_set_membase x86_cc_c dest 0 False++> class Sete a where+>   sete :: a -> CodeGen e s ()++> instance Sete Reg8 where+>   sete (Reg8 dest) = x86_set_reg x86_cc_e dest False+>+> instance Sete Addr where+>   sete (Addr dest) = x86_set_mem x86_cc_e dest False+>+> instance Sete (Disp, Reg32) where+>   sete (Disp disp, Reg32 dest) = x86_set_membase x86_cc_e dest disp False+>+> instance Sete Ind where+>   sete (Ind (Reg32 dest)) = x86_set_membase x86_cc_e dest 0 False++> class Setna a where+>   setna :: a -> CodeGen e s ()++> instance Setna Reg8 where+>   setna (Reg8 dest) = x86_set_reg x86_cc_na dest False+>+> instance Setna Addr where+>   setna (Addr dest) = x86_set_mem x86_cc_na dest False+>+> instance Setna (Disp, Reg32) where+>   setna (Disp disp, Reg32 dest) = x86_set_membase x86_cc_na dest disp False+>+> instance Setna Ind where+>   setna (Ind (Reg32 dest)) = x86_set_membase x86_cc_na dest 0 False++> class Setnae a where+>   setnae :: a -> CodeGen e s ()++> instance Setnae Reg8 where+>   setnae (Reg8 dest) = x86_set_reg x86_cc_nae dest False+>+> instance Setnae Addr where+>   setnae (Addr dest) = x86_set_mem x86_cc_nae dest False+>+> instance Setnae (Disp, Reg32) where+>   setnae (Disp disp, Reg32 dest) = x86_set_membase x86_cc_nae dest disp False+>+> instance Setnae Ind where+>   setnae (Ind (Reg32 dest)) = x86_set_membase x86_cc_nae dest 0 False++> class Setnb a where+>   setnb :: a -> CodeGen e s ()++> instance Setnb Reg8 where+>   setnb (Reg8 dest) = x86_set_reg x86_cc_nb dest False+>+> instance Setnb Addr where+>   setnb (Addr dest) = x86_set_mem x86_cc_nb dest False+>+> instance Setnb (Disp, Reg32) where+>   setnb (Disp disp, Reg32 dest) = x86_set_membase x86_cc_nb dest disp False+>+> instance Setnb Ind where+>   setnb (Ind (Reg32 dest)) = x86_set_membase x86_cc_nb dest 0 False++> class Setnbe a where+>   setnbe :: a -> CodeGen e s ()++> instance Setnbe Reg8 where+>   setnbe (Reg8 dest) = x86_set_reg x86_cc_nbe dest False+>+> instance Setnbe Addr where+>   setnbe (Addr dest) = x86_set_mem x86_cc_nbe dest False+>+> instance Setnbe (Disp, Reg32) where+>   setnbe (Disp disp, Reg32 dest) = x86_set_membase x86_cc_nbe dest disp False+>+> instance Setnbe Ind where+>   setnbe (Ind (Reg32 dest)) = x86_set_membase x86_cc_nbe dest 0 False++> class Setnc a where+>   setnc :: a -> CodeGen e s ()++> instance Setnc Reg8 where+>   setnc (Reg8 dest) = x86_set_reg x86_cc_nc dest False+>+> instance Setnc Addr where+>   setnc (Addr dest) = x86_set_mem x86_cc_nc dest False+>+> instance Setnc (Disp, Reg32) where+>   setnc (Disp disp, Reg32 dest) = x86_set_membase x86_cc_nc dest disp False+>+> instance Setnc Ind where+>   setnc (Ind (Reg32 dest)) = x86_set_membase x86_cc_nc dest 0 False++> class Setne a where+>   setne :: a -> CodeGen e s ()++> instance Setne Reg8 where+>   setne (Reg8 dest) = x86_set_reg x86_cc_ne dest False+>+> instance Setne Addr where+>   setne (Addr dest) = x86_set_mem x86_cc_ne dest False+>+> instance Setne (Disp, Reg32) where+>   setne (Disp disp, Reg32 dest) = x86_set_membase x86_cc_ne dest disp False+>+> instance Setne Ind where+>   setne (Ind (Reg32 dest)) = x86_set_membase x86_cc_ne dest 0 False++> class Setnp a where+>   setnp :: a -> CodeGen e s ()++> instance Setnp Reg8 where+>   setnp (Reg8 dest) = x86_set_reg x86_cc_np dest False+>+> instance Setnp Addr where+>   setnp (Addr dest) = x86_set_mem x86_cc_np dest False+>+> instance Setnp (Disp, Reg32) where+>   setnp (Disp disp, Reg32 dest) = x86_set_membase x86_cc_np dest disp False+>+> instance Setnp Ind where+>   setnp (Ind (Reg32 dest)) = x86_set_membase x86_cc_np dest 0 False++> class Setnz a where+>   setnz :: a -> CodeGen e s ()++> instance Setnz Reg8 where+>   setnz (Reg8 dest) = x86_set_reg x86_cc_nz dest False+>+> instance Setnz Addr where+>   setnz (Addr dest) = x86_set_mem x86_cc_nz dest False+>+> instance Setnz (Disp, Reg32) where+>   setnz (Disp disp, Reg32 dest) = x86_set_membase x86_cc_nz dest disp False+>+> instance Setnz Ind where+>   setnz (Ind (Reg32 dest)) = x86_set_membase x86_cc_nz dest 0 False++> class Setp a where+>   setp :: a -> CodeGen e s ()++> instance Setp Reg8 where+>   setp (Reg8 dest) = x86_set_reg x86_cc_p dest False+>+> instance Setp Addr where+>   setp (Addr dest) = x86_set_mem x86_cc_p dest False+>+> instance Setp (Disp, Reg32) where+>   setp (Disp disp, Reg32 dest) = x86_set_membase x86_cc_p dest disp False+>+> instance Setp Ind where+>   setp (Ind (Reg32 dest)) = x86_set_membase x86_cc_p dest 0 False++> class Setpe a where+>   setpe :: a -> CodeGen e s ()++> instance Setpe Reg8 where+>   setpe (Reg8 dest) = x86_set_reg x86_cc_pe dest False+>+> instance Setpe Addr where+>   setpe (Addr dest) = x86_set_mem x86_cc_pe dest False+>+> instance Setpe (Disp, Reg32) where+>   setpe (Disp disp, Reg32 dest) = x86_set_membase x86_cc_pe dest disp False+>+> instance Setpe Ind where+>   setpe (Ind (Reg32 dest)) = x86_set_membase x86_cc_pe dest 0 False++> class Setpo a where+>   setpo :: a -> CodeGen e s ()++> instance Setpo Reg8 where+>   setpo (Reg8 dest) = x86_set_reg x86_cc_po dest False+>+> instance Setpo Addr where+>   setpo (Addr dest) = x86_set_mem x86_cc_po dest False+>+> instance Setpo (Disp, Reg32) where+>   setpo (Disp disp, Reg32 dest) = x86_set_membase x86_cc_po dest disp False+>+> instance Setpo Ind where+>   setpo (Ind (Reg32 dest)) = x86_set_membase x86_cc_po dest 0 False++> class Setg a where+>   setg :: a -> CodeGen e s ()++> instance Setg Reg8 where+>   setg (Reg8 dest) = x86_set_reg x86_cc_gt dest True+>+> instance Setg Addr where+>   setg (Addr dest) = x86_set_mem x86_cc_gt dest True+>+> instance Setg (Disp, Reg32) where+>   setg (Disp disp, Reg32 dest) = x86_set_membase x86_cc_gt dest disp True+>+> instance Setg Ind where+>   setg (Ind (Reg32 dest)) = x86_set_membase x86_cc_gt dest 0 True++> class Setge a where+>   setge :: a -> CodeGen e s ()++> instance Setge Reg8 where+>   setge (Reg8 dest) = x86_set_reg x86_cc_ge dest True+>+> instance Setge Addr where+>   setge (Addr dest) = x86_set_mem x86_cc_ge dest True+>+> instance Setge (Disp, Reg32) where+>   setge (Disp disp, Reg32 dest) = x86_set_membase x86_cc_ge dest disp True+>+> instance Setge Ind where+>   setge (Ind (Reg32 dest)) = x86_set_membase x86_cc_ge dest 0 True++> class Setl a where+>   setl :: a -> CodeGen e s ()++> instance Setl Reg8 where+>   setl (Reg8 dest) = x86_set_reg x86_cc_lt dest True+>+> instance Setl Addr where+>   setl (Addr dest) = x86_set_mem x86_cc_lt dest True+>+> instance Setl (Disp, Reg32) where+>   setl (Disp disp, Reg32 dest) = x86_set_membase x86_cc_lt dest disp True+>+> instance Setl Ind where+>   setl (Ind (Reg32 dest)) = x86_set_membase x86_cc_lt dest 0 True++> class Setle a where+>   setle :: a -> CodeGen e s ()++> instance Setle Reg8 where+>   setle (Reg8 dest) = x86_set_reg x86_cc_le dest True+>+> instance Setle Addr where+>   setle (Addr dest) = x86_set_mem x86_cc_le dest True+>+> instance Setle (Disp, Reg32) where+>   setle (Disp disp, Reg32 dest) = x86_set_membase x86_cc_le dest disp True+>+> instance Setle Ind where+>   setle (Ind (Reg32 dest)) = x86_set_membase x86_cc_le dest 0 True++> class Setng a where+>   setng :: a -> CodeGen e s ()++> instance Setng Reg8 where+>   setng (Reg8 dest) = x86_set_reg x86_cc_le dest True+>+> instance Setng Addr where+>   setng (Addr dest) = x86_set_mem x86_cc_le dest True+>+> instance Setng (Disp, Reg32) where+>   setng (Disp disp, Reg32 dest) = x86_set_membase x86_cc_le dest disp True+>+> instance Setng Ind where+>   setng (Ind (Reg32 dest)) = x86_set_membase x86_cc_le dest 0 True++> class Setnge a where+>   setnge :: a -> CodeGen e s ()++> instance Setnge Reg8 where+>   setnge (Reg8 dest) = x86_set_reg x86_cc_lt dest True+>+> instance Setnge Addr where+>   setnge (Addr dest) = x86_set_mem x86_cc_lt dest True+>+> instance Setnge (Disp, Reg32) where+>   setnge (Disp disp, Reg32 dest) = x86_set_membase x86_cc_lt dest disp True+>+> instance Setnge Ind where+>   setnge (Ind (Reg32 dest)) = x86_set_membase x86_cc_lt dest 0 True++> class Setnl a where+>   setnl :: a -> CodeGen e s ()++> instance Setnl Reg8 where+>   setnl (Reg8 dest) = x86_set_reg x86_cc_ge dest True+>+> instance Setnl Addr where+>   setnl (Addr dest) = x86_set_mem x86_cc_ge dest True+>+> instance Setnl (Disp, Reg32) where+>   setnl (Disp disp, Reg32 dest) = x86_set_membase x86_cc_ge dest disp True+>+> instance Setnl Ind where+>   setnl (Ind (Reg32 dest)) = x86_set_membase x86_cc_ge dest 0 True++> class Setnle a where+>   setnle :: a -> CodeGen e s ()++> instance Setnle Reg8 where+>   setnle (Reg8 dest) = x86_set_reg x86_cc_gt dest True+>+> instance Setnle Addr where+>   setnle (Addr dest) = x86_set_mem x86_cc_gt dest True+>+> instance Setnle (Disp, Reg32) where+>   setnle (Disp disp, Reg32 dest) = x86_set_membase x86_cc_gt dest disp True+>+> instance Setnle Ind where+>   setnle (Ind (Reg32 dest)) = x86_set_membase x86_cc_gt dest 0 True++> class Setno a where+>   setno :: a -> CodeGen e s ()++> instance Setno Reg8 where+>   setno (Reg8 dest) = x86_set_reg x86_cc_no dest True+>+> instance Setno Addr where+>   setno (Addr dest) = x86_set_mem x86_cc_no dest True+>+> instance Setno (Disp, Reg32) where+>   setno (Disp disp, Reg32 dest) = x86_set_membase x86_cc_no dest disp True+>+> instance Setno Ind where+>   setno (Ind (Reg32 dest)) = x86_set_membase x86_cc_no dest 0 True++> class Setns a where+>   setns :: a -> CodeGen e s ()++> instance Setns Reg8 where+>   setns (Reg8 dest) = x86_set_reg x86_cc_ns dest True+>+> instance Setns Addr where+>   setns (Addr dest) = x86_set_mem x86_cc_ns dest True+>+> instance Setns (Disp, Reg32) where+>   setns (Disp disp, Reg32 dest) = x86_set_membase x86_cc_ns dest disp True+>+> instance Setns Ind where+>   setns (Ind (Reg32 dest)) = x86_set_membase x86_cc_ns dest 0 True++> class Seto a where+>   seto :: a -> CodeGen e s ()++> instance Seto Reg8 where+>   seto (Reg8 dest) = x86_set_reg x86_cc_o dest True+>+> instance Seto Addr where+>   seto (Addr dest) = x86_set_mem x86_cc_o dest True+>+> instance Seto (Disp, Reg32) where+>   seto (Disp disp, Reg32 dest) = x86_set_membase x86_cc_o dest disp True+>+> instance Seto Ind where+>   seto (Ind (Reg32 dest)) = x86_set_membase x86_cc_o dest 0 True++> class Sets a where+>   sets :: a -> CodeGen e s ()++> instance Sets Reg8 where+>   sets (Reg8 dest) = x86_set_reg x86_cc_s dest True+>+> instance Sets Addr where+>   sets (Addr dest) = x86_set_mem x86_cc_s dest True+>+> instance Sets (Disp, Reg32) where+>   sets (Disp disp, Reg32 dest) = x86_set_membase x86_cc_s dest disp True+>+> instance Sets Ind where+>   sets (Ind (Reg32 dest)) = x86_set_membase x86_cc_s dest 0 True++> class Setz a where+>   setz :: a -> CodeGen e s ()++> instance Setz Reg8 where+>   setz (Reg8 dest) = x86_set_reg x86_cc_z dest False+>+> instance Setz Addr where+>   setz (Addr dest) = x86_set_mem x86_cc_z dest False+>+> instance Setz (Disp, Reg32) where+>   setz (Disp disp, Reg32 dest) = x86_set_membase x86_cc_z dest disp False+>+> instance Setz Ind where+>   setz (Ind (Reg32 dest)) = x86_set_membase x86_cc_z dest 0 False+++call procedure++> class Call a where+>   call :: a -> CodeGen e s ()++> instance Call Word32 where+>   call imm = x86_call_imm imm +>+> instance Call Label where+>   call l = do x86_call_imm 0+>               emitFixup l (-4) Fixup32+>+> instance Call Reg32 where+>   call (Reg32 dest) = x86_call_reg dest +>+> instance Call Addr where+>   call (Addr dest) = x86_call_mem dest +>+> instance Call (Disp, Reg32) where+>   call (Disp disp, Reg32 dest) = x86_call_membase dest disp +>+> instance Call Ind where+>   call (Ind (Reg32 dest)) = x86_call_membase dest 0 +>+> instance Call (FunPtr a) where+>   call = x86_call_hs+++return from procedure++> ret :: CodeGen e s ()+> ret = x86_ret+>+> retN :: Word16 -> CodeGen e s ()+> retN n = x86_ret_imm n+++make stack frame++> enter :: Word16 -> CodeGen e s ()+> enter = x86_enter+++conditional move++> class Cmova a b where+>   cmova :: a -> b -> CodeGen e s ()++> instance Cmova Reg32 Reg32 where+>   cmova (Reg32 dest) (Reg32 source) = x86_cmov_reg x86_cc_a False dest source+>+> instance Cmova Reg32 Addr where+>   cmova (Reg32 dest) (Addr source) = x86_cmov_mem x86_cc_a False dest source+>+> instance Cmova Reg32 (Disp, Reg32) where+>   cmova (Reg32 dest) (Disp disp, Reg32 source) = x86_cmov_membase x86_cc_a False dest source disp+>+> instance Cmova Reg32 Ind where+>   cmova (Reg32 dest) (Ind (Reg32 source)) = x86_cmov_membase x86_cc_a False dest source 0++> class Cmovae a b where+>   cmovae :: a -> b -> CodeGen e s ()++> instance Cmovae Reg32 Reg32 where+>   cmovae (Reg32 dest) (Reg32 source) = x86_cmov_reg x86_cc_ae False dest source+>+> instance Cmovae Reg32 Addr where+>   cmovae (Reg32 dest) (Addr source) = x86_cmov_mem x86_cc_ae False dest source+>+> instance Cmovae Reg32 (Disp, Reg32) where+>   cmovae (Reg32 dest) (Disp disp, Reg32 source) = x86_cmov_membase x86_cc_ae False dest source disp+>+> instance Cmovae Reg32 Ind where+>   cmovae (Reg32 dest) (Ind (Reg32 source)) = x86_cmov_membase x86_cc_ae False dest source 0++> class Cmovb a b where+>   cmovb :: a -> b -> CodeGen e s ()++> instance Cmovb Reg32 Reg32 where+>   cmovb (Reg32 dest) (Reg32 source) = x86_cmov_reg x86_cc_b False dest source+>+> instance Cmovb Reg32 Addr where+>   cmovb (Reg32 dest) (Addr source) = x86_cmov_mem x86_cc_b False dest source+>+> instance Cmovb Reg32 (Disp, Reg32) where+>   cmovb (Reg32 dest) (Disp disp, Reg32 source) = x86_cmov_membase x86_cc_b False dest source disp+>+> instance Cmovb Reg32 Ind where+>   cmovb (Reg32 dest) (Ind (Reg32 source)) = x86_cmov_membase x86_cc_b False dest source 0++> class Cmovbe a b where+>   cmovbe :: a -> b -> CodeGen e s ()++> instance Cmovbe Reg32 Reg32 where+>   cmovbe (Reg32 dest) (Reg32 source) = x86_cmov_reg x86_cc_be False dest source+>+> instance Cmovbe Reg32 Addr where+>   cmovbe (Reg32 dest) (Addr source) = x86_cmov_mem x86_cc_be False dest source+>+> instance Cmovbe Reg32 (Disp, Reg32) where+>   cmovbe (Reg32 dest) (Disp disp, Reg32 source) = x86_cmov_membase x86_cc_be False dest source disp+>+> instance Cmovbe Reg32 Ind where+>   cmovbe (Reg32 dest) (Ind (Reg32 source)) = x86_cmov_membase x86_cc_be False dest source 0++> class Cmovc a b where+>   cmovc :: a -> b -> CodeGen e s ()++> instance Cmovc Reg32 Reg32 where+>   cmovc (Reg32 dest) (Reg32 source) = x86_cmov_reg x86_cc_c False dest source+>+> instance Cmovc Reg32 Addr where+>   cmovc (Reg32 dest) (Addr source) = x86_cmov_mem x86_cc_c False dest source+>+> instance Cmovc Reg32 (Disp, Reg32) where+>   cmovc (Reg32 dest) (Disp disp, Reg32 source) = x86_cmov_membase x86_cc_c False dest source disp+>+> instance Cmovc Reg32 Ind where+>   cmovc (Reg32 dest) (Ind (Reg32 source)) = x86_cmov_membase x86_cc_c False dest source 0++> class Cmove a b where+>   cmove :: a -> b -> CodeGen e s ()++> instance Cmove Reg32 Reg32 where+>   cmove (Reg32 dest) (Reg32 source) = x86_cmov_reg x86_cc_e False dest source+>+> instance Cmove Reg32 Addr where+>   cmove (Reg32 dest) (Addr source) = x86_cmov_mem x86_cc_e False dest source+>+> instance Cmove Reg32 (Disp, Reg32) where+>   cmove (Reg32 dest) (Disp disp, Reg32 source) = x86_cmov_membase x86_cc_e False dest source disp+>+> instance Cmove Reg32 Ind where+>   cmove (Reg32 dest) (Ind (Reg32 source)) = x86_cmov_membase x86_cc_e False dest source 0++> class Cmovna a b where+>   cmovna :: a -> b -> CodeGen e s ()++> instance Cmovna Reg32 Reg32 where+>   cmovna (Reg32 dest) (Reg32 source) = x86_cmov_reg x86_cc_na False dest source+>+> instance Cmovna Reg32 Addr where+>   cmovna (Reg32 dest) (Addr source) = x86_cmov_mem x86_cc_na False dest source+>+> instance Cmovna Reg32 (Disp, Reg32) where+>   cmovna (Reg32 dest) (Disp disp, Reg32 source) = x86_cmov_membase x86_cc_na False dest source disp+>+> instance Cmovna Reg32 Ind where+>   cmovna (Reg32 dest) (Ind (Reg32 source)) = x86_cmov_membase x86_cc_na False dest source 0++> class Cmovnae a b where+>   cmovnae :: a -> b -> CodeGen e s ()++> instance Cmovnae Reg32 Reg32 where+>   cmovnae (Reg32 dest) (Reg32 source) = x86_cmov_reg x86_cc_nae False dest source+>+> instance Cmovnae Reg32 Addr where+>   cmovnae (Reg32 dest) (Addr source) = x86_cmov_mem x86_cc_nae False dest source+>+> instance Cmovnae Reg32 (Disp, Reg32) where+>   cmovnae (Reg32 dest) (Disp disp, Reg32 source) = x86_cmov_membase x86_cc_nae False dest source disp+>+> instance Cmovnae Reg32 Ind where+>   cmovnae (Reg32 dest) (Ind (Reg32 source)) = x86_cmov_membase x86_cc_nae False dest source 0++> class Cmovnb a b where+>   cmovnb :: a -> b -> CodeGen e s ()++> instance Cmovnb Reg32 Reg32 where+>   cmovnb (Reg32 dest) (Reg32 source) = x86_cmov_reg x86_cc_nb False dest source+>+> instance Cmovnb Reg32 Addr where+>   cmovnb (Reg32 dest) (Addr source) = x86_cmov_mem x86_cc_nb False dest source+>+> instance Cmovnb Reg32 (Disp, Reg32) where+>   cmovnb (Reg32 dest) (Disp disp, Reg32 source) = x86_cmov_membase x86_cc_nb False dest source disp+>+> instance Cmovnb Reg32 Ind where+>   cmovnb (Reg32 dest) (Ind (Reg32 source)) = x86_cmov_membase x86_cc_nb False dest source 0++> class Cmovnbe a b where+>   cmovnbe :: a -> b -> CodeGen e s ()++> instance Cmovnbe Reg32 Reg32 where+>   cmovnbe (Reg32 dest) (Reg32 source) = x86_cmov_reg x86_cc_nbe False dest source+>+> instance Cmovnbe Reg32 Addr where+>   cmovnbe (Reg32 dest) (Addr source) = x86_cmov_mem x86_cc_nbe False dest source+>+> instance Cmovnbe Reg32 (Disp, Reg32) where+>   cmovnbe (Reg32 dest) (Disp disp, Reg32 source) = x86_cmov_membase x86_cc_nbe False dest source disp+>+> instance Cmovnbe Reg32 Ind where+>   cmovnbe (Reg32 dest) (Ind (Reg32 source)) = x86_cmov_membase x86_cc_nbe False dest source 0++> class Cmovnc a b where+>   cmovnc :: a -> b -> CodeGen e s ()++> instance Cmovnc Reg32 Reg32 where+>   cmovnc (Reg32 dest) (Reg32 source) = x86_cmov_reg x86_cc_nc False dest source+>+> instance Cmovnc Reg32 Addr where+>   cmovnc (Reg32 dest) (Addr source) = x86_cmov_mem x86_cc_nc False dest source+>+> instance Cmovnc Reg32 (Disp, Reg32) where+>   cmovnc (Reg32 dest) (Disp disp, Reg32 source) = x86_cmov_membase x86_cc_nc False dest source disp+>+> instance Cmovnc Reg32 Ind where+>   cmovnc (Reg32 dest) (Ind (Reg32 source)) = x86_cmov_membase x86_cc_nc False dest source 0++> class Cmovne a b where+>   cmovne :: a -> b -> CodeGen e s ()++> instance Cmovne Reg32 Reg32 where+>   cmovne (Reg32 dest) (Reg32 source) = x86_cmov_reg x86_cc_ne False dest source+>+> instance Cmovne Reg32 Addr where+>   cmovne (Reg32 dest) (Addr source) = x86_cmov_mem x86_cc_ne False dest source+>+> instance Cmovne Reg32 (Disp, Reg32) where+>   cmovne (Reg32 dest) (Disp disp, Reg32 source) = x86_cmov_membase x86_cc_ne False dest source disp+>+> instance Cmovne Reg32 Ind where+>   cmovne (Reg32 dest) (Ind (Reg32 source)) = x86_cmov_membase x86_cc_ne False dest source 0++> class Cmovnp a b where+>   cmovnp :: a -> b -> CodeGen e s ()++> instance Cmovnp Reg32 Reg32 where+>   cmovnp (Reg32 dest) (Reg32 source) = x86_cmov_reg x86_cc_np False dest source+>+> instance Cmovnp Reg32 Addr where+>   cmovnp (Reg32 dest) (Addr source) = x86_cmov_mem x86_cc_np False dest source+>+> instance Cmovnp Reg32 (Disp, Reg32) where+>   cmovnp (Reg32 dest) (Disp disp, Reg32 source) = x86_cmov_membase x86_cc_np False dest source disp+>+> instance Cmovnp Reg32 Ind where+>   cmovnp (Reg32 dest) (Ind (Reg32 source)) = x86_cmov_membase x86_cc_np False dest source 0++> class Cmovnz a b where+>   cmovnz :: a -> b -> CodeGen e s ()++> instance Cmovnz Reg32 Reg32 where+>   cmovnz (Reg32 dest) (Reg32 source) = x86_cmov_reg x86_cc_nz False dest source+>+> instance Cmovnz Reg32 Addr where+>   cmovnz (Reg32 dest) (Addr source) = x86_cmov_mem x86_cc_nz False dest source+>+> instance Cmovnz Reg32 (Disp, Reg32) where+>   cmovnz (Reg32 dest) (Disp disp, Reg32 source) = x86_cmov_membase x86_cc_nz False dest source disp+>+> instance Cmovnz Reg32 Ind where+>   cmovnz (Reg32 dest) (Ind (Reg32 source)) = x86_cmov_membase x86_cc_nz False dest source 0++> class Cmovp a b where+>   cmovp :: a -> b -> CodeGen e s ()++> instance Cmovp Reg32 Reg32 where+>   cmovp (Reg32 dest) (Reg32 source) = x86_cmov_reg x86_cc_p False dest source+>+> instance Cmovp Reg32 Addr where+>   cmovp (Reg32 dest) (Addr source) = x86_cmov_mem x86_cc_p False dest source+>+> instance Cmovp Reg32 (Disp, Reg32) where+>   cmovp (Reg32 dest) (Disp disp, Reg32 source) = x86_cmov_membase x86_cc_p False dest source disp+>+> instance Cmovp Reg32 Ind where+>   cmovp (Reg32 dest) (Ind (Reg32 source)) = x86_cmov_membase x86_cc_p False dest source 0++> class Cmovpe a b where+>   cmovpe :: a -> b -> CodeGen e s ()++> instance Cmovpe Reg32 Reg32 where+>   cmovpe (Reg32 dest) (Reg32 source) = x86_cmov_reg x86_cc_pe False dest source+>+> instance Cmovpe Reg32 Addr where+>   cmovpe (Reg32 dest) (Addr source) = x86_cmov_mem x86_cc_pe False dest source+>+> instance Cmovpe Reg32 (Disp, Reg32) where+>   cmovpe (Reg32 dest) (Disp disp, Reg32 source) = x86_cmov_membase x86_cc_pe False dest source disp+>+> instance Cmovpe Reg32 Ind where+>   cmovpe (Reg32 dest) (Ind (Reg32 source)) = x86_cmov_membase x86_cc_pe False dest source 0++> class Cmovpo a b where+>   cmovpo :: a -> b -> CodeGen e s ()++> instance Cmovpo Reg32 Reg32 where+>   cmovpo (Reg32 dest) (Reg32 source) = x86_cmov_reg x86_cc_po False dest source+>+> instance Cmovpo Reg32 Addr where+>   cmovpo (Reg32 dest) (Addr source) = x86_cmov_mem x86_cc_po False dest source+>+> instance Cmovpo Reg32 (Disp, Reg32) where+>   cmovpo (Reg32 dest) (Disp disp, Reg32 source) = x86_cmov_membase x86_cc_po False dest source disp+>+> instance Cmovpo Reg32 Ind where+>   cmovpo (Reg32 dest) (Ind (Reg32 source)) = x86_cmov_membase x86_cc_po False dest source 0++> class Cmovz a b where+>   cmovz :: a -> b -> CodeGen e s ()++> instance Cmovz Reg32 Reg32 where+>   cmovz (Reg32 dest) (Reg32 source) = x86_cmov_reg x86_cc_z False dest source+>+> instance Cmovz Reg32 Addr where+>   cmovz (Reg32 dest) (Addr source) = x86_cmov_mem x86_cc_z False dest source+>+> instance Cmovz Reg32 (Disp, Reg32) where+>   cmovz (Reg32 dest) (Disp disp, Reg32 source) = x86_cmov_membase x86_cc_z False dest source disp+>+> instance Cmovz Reg32 Ind where+>   cmovz (Reg32 dest) (Ind (Reg32 source)) = x86_cmov_membase x86_cc_z False dest source 0++> class Cmovg a b where+>   cmovg :: a -> b -> CodeGen e s ()++> instance Cmovg Reg32 Reg32 where+>   cmovg (Reg32 dest) (Reg32 source) = x86_cmov_reg x86_cc_gt True dest source+>+> instance Cmovg Reg32 Addr where+>   cmovg (Reg32 dest) (Addr source) = x86_cmov_mem x86_cc_gt True dest source+>+> instance Cmovg Reg32 (Disp, Reg32) where+>   cmovg (Reg32 dest) (Disp disp, Reg32 source) = x86_cmov_membase x86_cc_gt True dest source disp+>+> instance Cmovg Reg32 Ind where+>   cmovg (Reg32 dest) (Ind (Reg32 source)) = x86_cmov_membase x86_cc_gt True dest source 0++> class Cmovge a b where+>   cmovge :: a -> b -> CodeGen e s ()++> instance Cmovge Reg32 Reg32 where+>   cmovge (Reg32 dest) (Reg32 source) = x86_cmov_reg x86_cc_ge True dest source+>+> instance Cmovge Reg32 Addr where+>   cmovge (Reg32 dest) (Addr source) = x86_cmov_mem x86_cc_ge True dest source+>+> instance Cmovge Reg32 (Disp, Reg32) where+>   cmovge (Reg32 dest) (Disp disp, Reg32 source) = x86_cmov_membase x86_cc_ge True dest source disp+>+> instance Cmovge Reg32 Ind where+>   cmovge (Reg32 dest) (Ind (Reg32 source)) = x86_cmov_membase x86_cc_ge True dest source 0++> class Cmovl a b where+>   cmovl :: a -> b -> CodeGen e s ()++> instance Cmovl Reg32 Reg32 where+>   cmovl (Reg32 dest) (Reg32 source) = x86_cmov_reg x86_cc_lt True dest source+>+> instance Cmovl Reg32 Addr where+>   cmovl (Reg32 dest) (Addr source) = x86_cmov_mem x86_cc_lt True dest source+>+> instance Cmovl Reg32 (Disp, Reg32) where+>   cmovl (Reg32 dest) (Disp disp, Reg32 source) = x86_cmov_membase x86_cc_lt True dest source disp+>+> instance Cmovl Reg32 Ind where+>   cmovl (Reg32 dest) (Ind (Reg32 source)) = x86_cmov_membase x86_cc_lt True dest source 0++> class Cmovle a b where+>   cmovle :: a -> b -> CodeGen e s ()++> instance Cmovle Reg32 Reg32 where+>   cmovle (Reg32 dest) (Reg32 source) = x86_cmov_reg x86_cc_le True dest source+>+> instance Cmovle Reg32 Addr where+>   cmovle (Reg32 dest) (Addr source) = x86_cmov_mem x86_cc_le True dest source+>+> instance Cmovle Reg32 (Disp, Reg32) where+>   cmovle (Reg32 dest) (Disp disp, Reg32 source) = x86_cmov_membase x86_cc_le True dest source disp+>+> instance Cmovle Reg32 Ind where+>   cmovle (Reg32 dest) (Ind (Reg32 source)) = x86_cmov_membase x86_cc_le True dest source 0++> class Cmovng a b where+>   cmovng :: a -> b -> CodeGen e s ()++> instance Cmovng Reg32 Reg32 where+>   cmovng (Reg32 dest) (Reg32 source) = x86_cmov_reg x86_cc_le True dest source+>+> instance Cmovng Reg32 Addr where+>   cmovng (Reg32 dest) (Addr source) = x86_cmov_mem x86_cc_le True dest source+>+> instance Cmovng Reg32 (Disp, Reg32) where+>   cmovng (Reg32 dest) (Disp disp, Reg32 source) = x86_cmov_membase x86_cc_le True dest source disp+>+> instance Cmovng Reg32 Ind where+>   cmovng (Reg32 dest) (Ind (Reg32 source)) = x86_cmov_membase x86_cc_le True dest source 0++> class Cmovnge a b where+>   cmovnge :: a -> b -> CodeGen e s ()++> instance Cmovnge Reg32 Reg32 where+>   cmovnge (Reg32 dest) (Reg32 source) = x86_cmov_reg x86_cc_lt True dest source+>+> instance Cmovnge Reg32 Addr where+>   cmovnge (Reg32 dest) (Addr source) = x86_cmov_mem x86_cc_lt True dest source+>+> instance Cmovnge Reg32 (Disp, Reg32) where+>   cmovnge (Reg32 dest) (Disp disp, Reg32 source) = x86_cmov_membase x86_cc_lt True dest source disp+>+> instance Cmovnge Reg32 Ind where+>   cmovnge (Reg32 dest) (Ind (Reg32 source)) = x86_cmov_membase x86_cc_lt True dest source 0++> class Cmovnl a b where+>   cmovnl :: a -> b -> CodeGen e s ()++> instance Cmovnl Reg32 Reg32 where+>   cmovnl (Reg32 dest) (Reg32 source) = x86_cmov_reg x86_cc_ge True dest source+>+> instance Cmovnl Reg32 Addr where+>   cmovnl (Reg32 dest) (Addr source) = x86_cmov_mem x86_cc_ge True dest source+>+> instance Cmovnl Reg32 (Disp, Reg32) where+>   cmovnl (Reg32 dest) (Disp disp, Reg32 source) = x86_cmov_membase x86_cc_ge True dest source disp+>+> instance Cmovnl Reg32 Ind where+>   cmovnl (Reg32 dest) (Ind (Reg32 source)) = x86_cmov_membase x86_cc_ge True dest source 0++> class Cmovnle a b where+>   cmovnle :: a -> b -> CodeGen e s ()++> instance Cmovnle Reg32 Reg32 where+>   cmovnle (Reg32 dest) (Reg32 source) = x86_cmov_reg x86_cc_gt True dest source+>+> instance Cmovnle Reg32 Addr where+>   cmovnle (Reg32 dest) (Addr source) = x86_cmov_mem x86_cc_gt True dest source+>+> instance Cmovnle Reg32 (Disp, Reg32) where+>   cmovnle (Reg32 dest) (Disp disp, Reg32 source) = x86_cmov_membase x86_cc_gt True dest source disp+>+> instance Cmovnle Reg32 Ind where+>   cmovnle (Reg32 dest) (Ind (Reg32 source)) = x86_cmov_membase x86_cc_gt True dest source 0++> class Cmovno a b where+>   cmovno :: a -> b -> CodeGen e s ()++> instance Cmovno Reg32 Reg32 where+>   cmovno (Reg32 dest) (Reg32 source) = x86_cmov_reg x86_cc_no True dest source+>+> instance Cmovno Reg32 Addr where+>   cmovno (Reg32 dest) (Addr source) = x86_cmov_mem x86_cc_no True dest source+>+> instance Cmovno Reg32 (Disp, Reg32) where+>   cmovno (Reg32 dest) (Disp disp, Reg32 source) = x86_cmov_membase x86_cc_no True dest source disp+>+> instance Cmovno Reg32 Ind where+>   cmovno (Reg32 dest) (Ind (Reg32 source)) = x86_cmov_membase x86_cc_no True dest source 0++> class Cmovns a b where+>   cmovns :: a -> b -> CodeGen e s ()++> instance Cmovns Reg32 Reg32 where+>   cmovns (Reg32 dest) (Reg32 source) = x86_cmov_reg x86_cc_ns True dest source+>+> instance Cmovns Reg32 Addr where+>   cmovns (Reg32 dest) (Addr source) = x86_cmov_mem x86_cc_ns True dest source+>+> instance Cmovns Reg32 (Disp, Reg32) where+>   cmovns (Reg32 dest) (Disp disp, Reg32 source) = x86_cmov_membase x86_cc_ns True dest source disp+>+> instance Cmovns Reg32 Ind where+>   cmovns (Reg32 dest) (Ind (Reg32 source)) = x86_cmov_membase x86_cc_ns True dest source 0++> class Cmovo a b where+>   cmovo :: a -> b -> CodeGen e s ()++> instance Cmovo Reg32 Reg32 where+>   cmovo (Reg32 dest) (Reg32 source) = x86_cmov_reg x86_cc_o True dest source+>+> instance Cmovo Reg32 Addr where+>   cmovo (Reg32 dest) (Addr source) = x86_cmov_mem x86_cc_o True dest source+>+> instance Cmovo Reg32 (Disp, Reg32) where+>   cmovo (Reg32 dest) (Disp disp, Reg32 source) = x86_cmov_membase x86_cc_o True dest source disp+>+> instance Cmovo Reg32 Ind where+>   cmovo (Reg32 dest) (Ind (Reg32 source)) = x86_cmov_membase x86_cc_o True dest source 0++> class Cmovs a b where+>   cmovs :: a -> b -> CodeGen e s ()++> instance Cmovs Reg32 Reg32 where+>   cmovs (Reg32 dest) (Reg32 source) = x86_cmov_reg x86_cc_s True dest source+>+> instance Cmovs Reg32 Addr where+>   cmovs (Reg32 dest) (Addr source) = x86_cmov_mem x86_cc_s True dest source+>+> instance Cmovs Reg32 (Disp, Reg32) where+>   cmovs (Reg32 dest) (Disp disp, Reg32 source) = x86_cmov_membase x86_cc_s True dest source disp+>+> instance Cmovs Reg32 Ind where+>   cmovs (Reg32 dest) (Ind (Reg32 source)) = x86_cmov_membase x86_cc_s True dest source 0+++release stack frame++> leave :: CodeGen e s ()+> leave = x86_leave+++store ah into flags++> sahf :: CodeGen e s ()+> sahf = x86_sahf
+ Harpy/X86CGCombinators.hs view
@@ -0,0 +1,276 @@+--------------------------------------------------------------------------+-- |+-- Module      :  X86CodeGen+-- Copyright   :  (c) 2006 Martin Grabmueller and Dirk Kleeblatt+-- License     :  GPL+-- +-- Maintainer  :  {magr,klee}@cs.tu-berlin.de+-- Stability   :  quite experimental+-- Portability :  portable (but generated code non-portable)+--+-- This module exports several combinators for writing loops,+-- conditionals and function prolog\/epilog code.+--+-- Note: this module is under heavy development and the exported API+-- is definitely not yet stable.+--------------------------------------------------------------------------++module Harpy.X86CGCombinators(+  -- * Types+  UserState(..),+  UserEnv(..),+  CtrlDest(..),+  DataDest(..),+  -- * Combinators+  ifThenElse, +  doWhile,+  continue,+  continueBranch,+  withDataDest,+  withCtrlDest,+  withDest,+  function,+  withRegister+  ) where++import Text.PrettyPrint.HughesPJ++import Foreign++import Harpy.CodeGenMonad+import Harpy.X86CodeGen++-- | Destination for a calculated value.+data DataDest = RegDest Word8            -- ^ Store into specific register+              | StackDest                -- ^ Push onto stack+              | MemBaseDest Word8 Word32 -- ^ Store at memory address+              | Ignore                   -- ^ Throw result away.++-- | Destination for control transfers+data CtrlDest = FallThrough              -- ^ Go to next instruction+              | Return                   -- ^ Return from current functio+              | Goto Label               -- ^ Go to specific label+              | Branch CtrlDest CtrlDest -- ^ Go to one of the given labels+                                         -- depending on outcome of test++-- | User state is used to maintain bitmask of registers currently in use.+data UserState = UserState { usedRegs :: Int}++                             +-- | User environment stores code generators for accessing specific+-- variables as well as the current data and control destinations+data UserEnv = UserEnv { bindings :: [(String, +                                       CodeGen UserEnv UserState ())],+                         dataDest :: DataDest,+                         ctrlDest :: CtrlDest }++emptyUserState = UserState{usedRegs = 0}++emptyUserEnv = UserEnv{bindings = [], dataDest = Ignore,+                       ctrlDest = Return}++ifThenElse :: CodeGen UserEnv s r+	      -> CodeGen UserEnv s a+	      -> CodeGen UserEnv s a1+	      -> CodeGen UserEnv s ()+ifThenElse condCg thenCg elseCg =+    do env <- getEnv +       elseLabel <- newLabel+       endLabel <- newLabel+       withDest Ignore (Branch FallThrough (Goto elseLabel)) +         (condCg)+       withCtrlDest (case ctrlDest env of +                       FallThrough -> Goto endLabel+                       _ -> ctrlDest env)+                    (thenCg >> continue)+       defineLabel elseLabel+       elseCg >> continue+       defineLabel endLabel++doWhile :: CodeGen UserEnv s r -> CodeGen UserEnv s a -> CodeGen UserEnv s ()+doWhile condCg bodyCg =+    do topLabel <- newLabel+       testLabel <- newLabel+       emitFixup testLabel 1 Fixup8+       x86_jump8 0+       defineLabel topLabel+       withCtrlDest FallThrough (bodyCg >> continue)+       defineLabel testLabel+       withDest Ignore (Branch (Goto topLabel) FallThrough) condCg +       continue++continue :: CodeGen UserEnv s ()+continue =+    do env <- getEnv+       cont (ctrlDest env)+  where+  cont FallThrough = return ()+  cont (Goto l) = emitFixup l 1 Fixup32 >> x86_jump32 0+  cont (Branch _ _) = error "Branch in continue"+  cont Return = x86_epilog 0+++continueBranch :: Int -> Bool -> CodeGen UserEnv s ()+continueBranch cc isSigned =+    do env <- getEnv+       let Branch c1 c2 = ctrlDest env+       cont cc isSigned c1 c2+  where+  cont cc isSigned (Goto l1) (Goto l2) =+    do emitFixup l1 1 Fixup32+       x86_branch32 cc 0 isSigned+       emitFixup l2 1 Fixup32+       x86_branch32 (negateCC cc) 0 isSigned+  cont cc isSigned (Goto l1) FallThrough =+    do emitFixup l1 1 Fixup32+       x86_branch32 cc 0 isSigned+  cont cc isSigned FallThrough (Goto l2) =+    do emitFixup l2 1 Fixup32+       x86_branch32 (negateCC cc) 0 isSigned+  cont cc isSigned (Goto l1) Return =+    do emitFixup l1 1 Fixup32+       x86_branch32 cc 0 isSigned+       withCtrlDest Return continue+  cont cc isSigned Return (Goto l2) =+    do emitFixup l2 1 Fixup32+       x86_branch32 (negateCC cc) 0 isSigned+       withCtrlDest Return continue+  cont _ _ _ _ = error "unhandled case in continueBranch"++reg sreg =+    do env <- getEnv+       reg' sreg (dataDest env)+  where+  reg' sreg (RegDest r) = +    do if sreg /= r +          then x86_mov_reg_reg r sreg x86_dword_size +          else return ()+  reg' sreg (StackDest) = +    do x86_push_reg sreg+  reg' sreg (MemBaseDest r offset) = +    do x86_mov_membase_reg r offset sreg x86_dword_size+  reg' sreg Ignore = return () ++membase reg ofs =+    do env <- getEnv+       membase' reg ofs (dataDest env)+  where+  membase' reg ofs (RegDest r) = +    do x86_mov_reg_membase r reg ofs x86_dword_size+  membase' reg ofs (StackDest) = +    do x86_push_membase reg ofs+  membase' reg ofs (MemBaseDest r offset) = +    do x86_mov_reg_membase x86_edi reg ofs x86_dword_size+       x86_mov_membase_reg r offset x86_edi x86_dword_size+  membase' reg ofs Ignore = return () ++global ofs =+    do env <- getEnv+       global' ofs (dataDest env)+  where+  global' ofs (RegDest r) = +    do x86_mov_reg_mem r ofs x86_dword_size+  global' ofs (StackDest) = +    do x86_push_mem ofs+  global' ofs (MemBaseDest r offset) = +    do x86_mov_reg_mem x86_edi ofs x86_dword_size+       x86_mov_membase_reg r offset x86_edi x86_dword_size+  global' ofs Ignore = return ()++immediate value =+    do env <- getEnv+       immediate' value (dataDest env)+  where+  immediate' value (RegDest r) = +    do x86_mov_reg_imm r value+  immediate' value (StackDest) = +    do x86_push_imm value+  immediate' value (MemBaseDest r offset) = +    do x86_mov_reg_imm x86_edi value +       x86_mov_membase_reg r offset x86_edi x86_dword_size+  immediate' ofs Ignore = return ()++-- | Save a number of registers on the stack, perform the given code+-- generation, and restore the registers.+saveRegs :: (Bits a) =>+	    a -> CodeGen UserEnv s r -> CodeGen UserEnv s ()+saveRegs reg_mask cg =+    do gen_push 0 1+       withCtrlDest FallThrough cg+       gen_pop x86_edi (1 `shiftL` (fromIntegral x86_edi))+       continue+  where+  gen_push i m =+     if i <= x86_edi+        then do if (reg_mask .&. m) /= 0+                   then x86_push_reg i+                   else return ()+                gen_push (i + 1) (m `shiftL` 1)+        else return ()+  gen_pop i m =+    if m /= 0+       then do if (reg_mask .&. m) /= 0+                  then x86_pop_reg i+                  else return ()+               gen_pop (i - 1) (m `shiftR` 1)+       else return ()++-- | Perform the code generation associated with the variable given.+loadVar :: String -> CodeGen UserEnv UserState ()+loadVar name =+    do UserEnv{bindings = assoc} <- getEnv+       case lookup name assoc of+         Just cg -> cg+         Nothing -> failCodeGen (text ("undefined variable: " ++ name))++-- | Find a register not recorded in the given bit mask.+findReg :: (Bits a) => a -> Word8+findReg reg_mask = findR 0 1+  where+   findR i m =+     if i <= x86_edi+        then if (reg_mask .&. m) == 0+                   then i+                   else findR (i + 1) (m `shiftL` 1)+        else error "no register left for allocation"+    ++-- | Set the data destinations to the given values while+-- running the code generator.+withDataDest :: DataDest -> CodeGen UserEnv s r -> CodeGen UserEnv s r+withDataDest ddest cg =+    do env <- getEnv+       withEnv (env{dataDest = ddest}) cg++-- | Set the control destinations to the given values while+-- running the code generator.+withCtrlDest :: CtrlDest -> CodeGen UserEnv s r -> CodeGen UserEnv s r+withCtrlDest cdest cg =+    do env <- getEnv+       withEnv (env{ctrlDest = cdest}) cg++-- | Set the data and control destinations to the given values while+-- running the code generator.+withDest :: DataDest -> CtrlDest -> CodeGen UserEnv s r -> CodeGen UserEnv s r+withDest ddest cdest cg =+    do env <- getEnv+       withEnv (env{dataDest = ddest, ctrlDest = cdest}) cg++-- | Emit the necessary function prolog and epilog code and invoke the+-- given code generator for the code inbetween.+function :: CodeGen UserEnv s r -> CodeGen UserEnv s r+function cg =+    do x86_prolog 0 0+       withDataDest (RegDest x86_eax) $ withCtrlDest Return $ cg++-- | Apply the given cg to a register, which is reserved while the+-- generator is running.+withRegister :: (Word8 -> CodeGen e UserState t) -> CodeGen e UserState ()+withRegister cg =+    do state <- getState+       let used = usedRegs state+       let reg = findReg used+       setState (state{usedRegs = used .|. (1 `shiftL` fromIntegral reg)})+       cg reg+       state <- getState+       setState (state{usedRegs = used})
+ Harpy/X86CodeGen.hs view
@@ -0,0 +1,1780 @@+--------------------------------------------------------------------------+-- |+-- Module      :  X86CodeGen+-- Copyright   :  (c) 2006 Martin Grabmueller and Dirk Kleeblatt+-- License     :  GPL+-- +-- Maintainer  :  {magr,klee}@cs.tu-berlin.de+-- Stability   :  provisional+-- Portability :  portable (but generated code non-portable)+--+-- Functions for generating x86 machine code instructions.  The+-- functions make use of the code generation monad in module+-- "Harpy.CodeGenMonad" for emitting binary code into a code buffer.+--+-- This module is very low-level, since there are different+-- functions for different addressing modes.  A more convenient+-- interface is provided in module "Harpy.X86Assembler", which uses+-- the operand types to determine the correct addressing modes for+-- all supported instructions.+--+-- Note: this file does not (yet) provide the complete x86+-- instruction set, not even all user-mode instructions.  For some+-- operations, some addressing modes are missing as well.+--+-- Copyright notice:+--+-- The information in this file is based on the header file+-- x86-codegen.h from the mono distribution, which has the following+-- copyright information:+-- +-- @ +--  * x86-codegen.h: Macros for generating x86 code+--  *+--  * Authors:+--  *   Paolo Molaro (lupus\@ximian.com)+--  *   Intel Corporation (ORP Project)+--  *   Sergey Chaban (serge\@wildwestsoftware.com)+--  *   Dietmar Maurer (dietmar\@ximian.com)+--  *   Patrik Torstensson+--  * +--  * Copyright (C)  2000 Intel Corporation.  All rights reserved.+--  * Copyright (C)  2001, 2002 Ximian, Inc.+--  *+-- @+--------------------------------------------------------------------------++module Harpy.X86CodeGen(+    -- * Constants+    -- ** Machine characteristics+    x86_dword_size, +    x86_qword_size, +    -- ** Register numbers+    -- | x86 general-purpose register numbers+    x86_eax, x86_ecx, x86_edx, x86_ebx, x86_esp, x86_ebp, x86_esi, x86_edi,+    x86_nobasereg,+    -- ** Register masks and predicates+    x86_eax_mask, x86_ecx_mask, x86_edx_mask, x86_ebx_mask,+    x86_esi_mask, x86_edi_mask, +    x86_callee_regs, x86_caller_regs, x86_byte_regs,+    -- ** ALU operations+    x86_add, x86_or, x86_adc, x86_sbb, x86_and, x86_sub, x86_xor, x86_cmp,+    -- ** Shift operations+    x86_rol, x86_ror, x86_rcl, x86_rcr, x86_shl,+    x86_shr, x86_sar,+    -- ** Condition codes+    x86_cc_eq, x86_cc_e, x86_cc_z,+    x86_cc_ne, x86_cc_nz,+    x86_cc_lt, x86_cc_b, x86_cc_c, x86_cc_nae, x86_cc_le, x86_cc_be, +    x86_cc_na, x86_cc_gt, x86_cc_a, x86_cc_nbe, x86_cc_ge, x86_cc_ae, +    x86_cc_nb, x86_cc_nc, x86_cc_lz, x86_cc_s, x86_cc_gez, x86_cc_ns, +    x86_cc_p, x86_cc_np, x86_cc_pe, x86_cc_po, x86_cc_o, x86_cc_no,+    -- * Functions+    -- ** Utility functions+    x86_is_scratch, x86_is_callee,+    -- ** Code emission+    x86_imm_emit32, x86_imm_emit16, x86_imm_emit8, +    x86_membase_emit, x86_alu_reg_imm,+    -- ** Call instructions+    x86_call_hs, x86_call_membase, x86_call_mem, x86_call_reg, +    x86_call_imm,+    -- ** Function prologue and epilogue+    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_jump_membase, x86_jump_mem, x86_jump_reg, +    x86_jump32, x86_jump8, +    x86_loopne, x86_loope, x86_loop, +    -- ** Stack operations+    x86_push_reg, x86_push_regp, x86_push_mem, x86_push_membase,+    x86_push_imm, x86_push_imm_template, x86_push_memindex,+    x86_pop_membase, x86_pop_mem, x86_pop_reg,+    x86_popfd, x86_pushfd, x86_popad, x86_pushad,+    -- ** Data movement+    x86_mov_reg_reg, x86_mov_reg_imm, x86_mov_mem_imm, x86_mov_membase_imm,+    x86_mov_memindex_imm, x86_mov_mem_reg, x86_mov_reg_mem, +    x86_mov_regp_reg, x86_mov_reg_regp, x86_mov_membase_reg,+    x86_mov_reg_membase, x86_mov_memindex_reg, x86_mov_reg_memindex,+    -- ** Arithmetic+    x86_xadd_reg_reg, x86_xadd_mem_reg, x86_xadd_membase_reg, +    x86_inc_mem, x86_inc_membase, x86_inc_reg,+    x86_dec_mem, x86_dec_membase, x86_dec_reg,+    x86_not_mem, x86_not_membase, x86_not_reg,+    x86_neg_mem, x86_neg_membase, x86_neg_reg, +    x86_alu_mem_imm, x86_alu_membase_imm, x86_alu_membase8_imm,+    x86_alu_mem_reg, x86_alu_membase_reg, x86_alu_reg_reg,+    x86_alu_reg8_reg8, x86_alu_reg_mem, x86_alu_reg_membase,+    x86_mul_reg, x86_mul_mem, x86_mul_membase, +    x86_imul_reg_reg, x86_imul_reg_membase, x86_imul_reg_reg_imm,+    x86_imul_reg_mem,+    x86_imul_reg_mem_imm, x86_imul_reg_membase_imm,+    x86_div_reg, x86_div_mem, x86_div_membase,+    x86_test_reg_imm, x86_test_mem_imm, x86_test_membase_imm,+    x86_test_reg_reg, x86_test_mem_reg, x86_test_membase_reg,+    -- ** Exchange+    x86_cmpxchg_reg_reg, x86_cmpxchg_mem_reg, x86_cmpxchg_membase_reg,+    x86_xchg_reg_reg, x86_xchg_mem_reg, x86_xchg_membase_reg,+    -- ** String operations+    x86_stosb, x86_stosl, x86_stosd, x86_movsb, x86_movsl, x86_movsd,+    -- ** Bitwise shift+    x86_shift_reg_imm, x86_shift_mem_imm, x86_shift_membase_imm,+    x86_shift_reg, x86_shift_mem, x86_shift_membase,+    x86_shrd_reg, x86_shrd_reg_imm, x86_shld_reg, x86_shld_reg_imm,+    -- ** Conditional move+    x86_cmov_membase, x86_cmov_mem, x86_cmov_reg, +    -- ** Conditional set+    x86_set_membase, x86_set_mem, x86_set_reg,+    -- ** Address calculation+    x86_lea_mem, x86_lea_membase, x86_lea_memindex,+    -- ** Conversion +    x86_cdq,x86_widen_memindex, x86_widen_membase, x86_widen_mem, +    x86_widen_reg,+    -- ** Miscellaneous+    x86_sahf, x86_wait, x86_nop, x86_breakpoint, x86_rdtsc, x86_cld,+    -- ** Other utilities+    negateCC+                       ) where++import qualified Text.PrettyPrint.HughesPJ as PP++import Debug.Trace++import Data.Word+import Data.Bits++import Foreign.Ptr++import Harpy.CodeGenMonad+++-- |  Sizes of various machine data types in bytes.+x86_dword_size, x86_qword_size :: Int++x86_dword_size = 4                    -- Number of bytes in doubleword+x86_qword_size = 8                    -- Number of bytes in quadword++x86_eax, x86_ecx, x86_edx, x86_ebx, x86_esp, x86_ebp, x86_esi,+  x86_edi :: Word8+x86_eax = 0+x86_ecx = 1+x86_edx = 2+x86_ebx = 3+x86_esp = 4+x86_ebp = 5+x86_esi = 6+x86_edi = 7++-- | Opcodes for ALU instructions+x86_cmp, x86_or, x86_adc, x86_sbb, x86_and, x86_sub, x86_xor, +  x86_add :: Word8+x86_add = 0+x86_or  = 1+x86_adc = 2+x86_sbb = 3+x86_and = 4+x86_sub = 5+x86_xor = 6+x86_cmp = 7++-- | Opcodes for shift instructions+x86_sar, x86_shld, x86_shlr, x86_rol, x86_ror, x86_rcl, x86_rcr,+  x86_shl, x86_shr :: Word8++x86_shld = 0+x86_shlr = 1+x86_rol  = 0+x86_ror  = 1+x86_rcl  = 2+x86_rcr  = 3+x86_shl  = 4+x86_shr  = 5+x86_sar  = 7++-- | Opcodes for floating-point instructions++x86_fadd, x86_fmul, x86_fcom, x86_fcomp, x86_fsub, x86_fsubr :: Word8+x86_fdiv, x86_fdivr :: Word8++x86_fadd  = 0+x86_fmul  = 1+x86_fcom  = 2+x86_fcomp = 3+x86_fsub  = 4+x86_fsubr = 5+x86_fdiv  = 6+x86_fdivr = 7++-- | Integer conditions codes+x86_cc_no, x86_cc_eq, x86_cc_e, x86_cc_z, x86_cc_ne, x86_cc_nz, x86_cc_lt :: Int+x86_cc_b, x86_cc_c, x86_cc_nae, x86_cc_le, x86_cc_be, x86_cc_na :: Int+x86_cc_gt :: Int+x86_cc_a, x86_cc_nbe, x86_cc_ge, x86_cc_ae, x86_cc_nb, x86_cc_nc :: Int+x86_cc_lz, x86_cc_s, x86_cc_gez, x86_cc_ns, x86_cc_p, x86_cc_pe :: Int+x86_cc_np, x86_cc_po, x86_cc_o :: Int+x86_cc_eq  = 0+x86_cc_e   = 0+x86_cc_z   = 0+x86_cc_ne  = 1+x86_cc_nz  = 1+x86_cc_lt  = 2+x86_cc_b   = 2+x86_cc_c   = 2+x86_cc_nae = 2+x86_cc_le  = 3+x86_cc_be  = 3+x86_cc_na  = 3+x86_cc_gt  = 4+x86_cc_a   = 4+x86_cc_nbe = 4+x86_cc_ge  = 5+x86_cc_ae  = 5+x86_cc_nb  = 5+x86_cc_nc  = 5+x86_cc_lz  = 6+x86_cc_s   = 6+x86_cc_gez = 7+x86_cc_ns  = 7+x86_cc_p   = 8+x86_cc_pe  = 8+x86_cc_np  = 9+x86_cc_po  = 9+x86_cc_o   = 10+x86_cc_no  = 11++-- | FP status+x86_fp_c0, x86_fp_c1, x86_fp_c2, x86_fp_c3, x86_fp_cc_mask :: Word32+x86_fp_c0 = 0x100+x86_fp_c1 = 0x200+x86_fp_c2 = 0x400+x86_fp_c3 = 0x4000+x86_fp_cc_mask = 0x4500++-- | FP control word+x86_fpcw_invopex_mask, x86_fpcw_denopex_mask, x86_fpcw_zerodiv_mask, + x86_fpcw_ovfex_mask, x86_fpcw_undfex_mask, x86_fpcw_precex_mask, + x86_fpcw_precc_mask, x86_fpcw_roundc_mask :: Word32++x86_fpcw_invopex_mask = 0x1+x86_fpcw_denopex_mask = 0x2+x86_fpcw_zerodiv_mask = 0x4+x86_fpcw_ovfex_mask   = 0x8+x86_fpcw_undfex_mask  = 0x10+x86_fpcw_precex_mask  = 0x20+x86_fpcw_precc_mask   = 0x300+x86_fpcw_roundc_mask  = 0xc00++-- | Values for precision control+x86_fpcw_prec_single, x86_fpcw_prec_double, + x86_fpcw_prec_extended :: Word32+x86_fpcw_prec_single    = 0+x86_fpcw_prec_double    = 0x200+x86_fpcw_prec_extended  = 0x300++-- | Values for rounding control+x86_fpcw_round_nearest, x86_fpcw_round_down, x86_fpcw_round_up,+ x86_fpcw_round_tozero :: Word32+x86_fpcw_round_nearest  = 0+x86_fpcw_round_down     = 0x400+x86_fpcw_round_up       = 0x800+x86_fpcw_round_tozero   = 0xc00++-- | Prefix codes+x86_lock_prefix, x86_repnz_prefix, x86_repz_prefix, x86_rep_prefix,+ x86_cs_prefix, x86_ss_prefix, x86_ds_prefix, x86_es_prefix,+ x86_fs_prefix, x86_gs_prefix, x86_unlikely_prefix,+ x86_likely_prefix, x86_operand_prefix, x86_address_prefix :: Word8+x86_lock_prefix = 0xf0+x86_repnz_prefix = 0xf2+x86_repz_prefix = 0xf3 +x86_rep_prefix = 0xf3+x86_cs_prefix = 0x2e+x86_ss_prefix = 0x36+x86_ds_prefix = 0x3e+x86_es_prefix = 0x26+x86_fs_prefix = 0x64+x86_gs_prefix = 0x65+x86_unlikely_prefix = 0x2e+x86_likely_prefix = 0x3e+x86_operand_prefix = 0x66+x86_address_prefix = 0x67++-- | Mapping from condition code to opcode (unsigned)+x86_cc_unsigned_map = [+       0x74, -- eq  +       0x75, -- ne  +       0x72, -- lt  +       0x76, -- le  +       0x77, -- gt  +       0x73, -- ge  +       0x78, -- lz  +       0x79, -- gez +       0x7a, -- p   +       0x7b, -- np  +       0x70, -- o  +       0x71  -- no  + ]++-- | Mapping from condition code to opcode (signed)+x86_cc_signed_map = [+      0x74, -- eq  +      0x75, -- ne  +      0x7c, -- lt  +      0x7e, -- le  +      0x7f, -- gt  +      0x7d, -- ge  +      0x78, -- lz  +      0x79, -- gez +      0x7a, -- p   +      0x7b, -- np  +      0x70, -- o  +      0x71  -- no  + ]++-- | Mapping from condition code to negated condition code.+x86_cc_negate = [+       (x86_cc_eq, x86_cc_ne), -- eq  +       (x86_cc_ne, x86_cc_eq), -- ne  +       (x86_cc_lt, x86_cc_ge), -- lt  +       (x86_cc_le, x86_cc_gt), -- le  +       (x86_cc_gt, x86_cc_le), -- gt  +       (x86_cc_ge, x86_cc_lt), -- ge  +       (x86_cc_lz, x86_cc_gez), -- lz  +       (x86_cc_gez, x86_cc_lz), -- gez +       (x86_cc_p, x86_cc_np), -- p   +       (x86_cc_np, x86_cc_p), -- np  +       (x86_cc_o, x86_cc_no), -- o  +       (x86_cc_no, x86_cc_o)  -- no  + ]++-- | Invert a condition code.+negateCC :: Int -> Int+negateCC cc =+    case lookup cc x86_cc_negate of+      Just cc' -> cc'+      Nothing -> error ("unhandled case in negateCC" ++ show cc)++-- | Used to encode the fact that no base register is used in an+-- instruction.+x86_nobasereg :: Word8+x86_nobasereg = (-1)++-- | Bitvector masks for general-purpose registers+x86_edi_mask, x86_esi_mask, x86_ebx_mask, x86_ebp_mask,+    x86_eax_mask, x86_ecx_mask, x86_edx_mask:: Int+x86_esi_mask = (1 `shiftL` (fromIntegral x86_esi))+x86_edi_mask = (1 `shiftL` (fromIntegral x86_edi))+x86_ebx_mask = (1 `shiftL` (fromIntegral x86_ebx))+x86_ebp_mask = (1 `shiftL` (fromIntegral x86_ebp))+x86_eax_mask = (1 `shiftL` (fromIntegral x86_eax))+x86_ecx_mask = (1 `shiftL` (fromIntegral x86_ecx))+x86_edx_mask = (1 `shiftL` (fromIntegral x86_edx))++-- | Bitvector mask for callee-saved registers+x86_callee_regs :: Int+x86_callee_regs = ((1 `shiftL` (fromIntegral x86_eax)) .|. +           (1 `shiftL` (fromIntegral x86_ecx)) .|. +           (1 `shiftL` (fromIntegral x86_edx)))++-- | Bitvector mask for caller-saved registers+x86_caller_regs :: Int+x86_caller_regs = ((1 `shiftL` (fromIntegral x86_ebx)) .|.+           (1 `shiftL` (fromIntegral x86_ebp)) .|. +           (1 `shiftL` (fromIntegral x86_esi)) .|. +           (1 `shiftL` (fromIntegral x86_edi)))++-- | Bitvector mask for byte-adressable registers+x86_byte_regs :: Int+x86_byte_regs =  ((1 `shiftL` (fromIntegral x86_eax)) .|.+          (1 `shiftL` (fromIntegral x86_ecx)) .|. +          (1 `shiftL` (fromIntegral x86_edx)) .|. +          (1 `shiftL` (fromIntegral x86_ebx)))++-- | Returns true when the given register is caller-saved.+x86_is_scratch :: Int -> Bool+x86_is_scratch reg = (x86_caller_regs .&. (1 `shiftL` (reg))) /= 0++-- | Returns true when the given register is caller-saved.+x86_is_callee :: Int -> Bool++x86_is_callee reg =  (x86_callee_regs .&. (1 `shiftL` (reg))) /= 0++-- | Returns true when the given register is byte-addressable.+x86_is_byte_reg :: (Num a, Ord a) => a -> Bool+x86_is_byte_reg reg = ((reg) < 4)++++-- useful building blocks+++x86_modrm_mod modrm = ((modrm) `shiftR` 6)+x86_modrm_reg modrm = (((modrm) `shiftR` 3) .&. 0x7)+x86_modrm_rm modrm = ((modrm) .&. 0x7)++x86_address_byte m o r = emit8 ((((m) .&. 0x03) `shiftL` 6) .|.+                               (((o) .&. 0x07) `shiftL` 3) .|. +                                (((r) .&. 0x07)))++-- | Emit a 32-bit constant to the instruction stream.+x86_imm_emit32 :: Word32 -> CodeGen e s ()+x86_imm_emit32 imm = emit32 imm++-- | Emit a 32-bit constant to the instruction stream at the given offset.+x86_imm_emit32_at pos imm = emit32At pos imm++-- | Emit a 16-bit constant to the instruction stream.+x86_imm_emit16 :: Word16 -> CodeGen e s ()+x86_imm_emit16 imm =+    let b0 = (imm .&. 0xff)+        b1 = ((imm `shiftR` 8) .&. 0xff)+    in do emit8 (fromIntegral b0)+          emit8 (fromIntegral b1)++-- | Emit a 8-bit constant to the instruction stream.+x86_imm_emit8 :: Word8 -> CodeGen e s ()+x86_imm_emit8 imm = +  emit8 (imm .&. 0xff)++-- | Emit a 8-bit constant to the instruction stream at the given offset.+x86_imm_emit8_at pos imm = +  emit8At pos (imm .&. 0xff)++-- | Return true if the given value is a signed 8-bit constant.+x86_is_imm8 imm =  (((fromIntegral imm :: Integer) >= -128) && ((fromIntegral imm :: Integer) <= 127))+x86_is_imm16 imm = (((fromIntegral imm :: Integer) >= -(1 `shiftL` 16)) && +                              ((fromIntegral imm :: Integer) <= ((1 `shiftL` 16)-1)))++x86_reg_emit r regno = x86_address_byte 3 r regno+x86_reg8_emit r regno is_rh is_rnoh = +  x86_address_byte 3 (if is_rh then (r .|. 4) else r) +                     (if is_rnoh then regno .|. 4 else regno)++-- | Emit a register-indirect address encoding.+x86_regp_emit :: Word8 -> Word8 -> CodeGen e s ()+x86_regp_emit r regno = x86_address_byte 0 r regno++-- | Emit a memory+displacement address encoding.+x86_mem_emit :: Word8 -> Word32 -> CodeGen e s ()+x86_mem_emit r disp = do x86_address_byte 0 r 5+                         x86_imm_emit32 disp++-- | Emit a mem+base address encoding+x86_membase_emit :: Word8 -> Word8 -> Word32 -> CodeGen e s ()+x86_membase_emit r basereg disp =+    if basereg == x86_esp+       then if disp == 0+               then do x86_address_byte 0 r x86_esp +                       x86_address_byte 0 x86_esp x86_esp+               else if x86_is_imm8 disp+                       then do x86_address_byte 1 r x86_esp+                               x86_address_byte 0 x86_esp x86_esp+                               x86_imm_emit8 (fromIntegral disp)+                       else do x86_address_byte 2 r x86_esp+                               x86_address_byte 0 x86_esp x86_esp+                               x86_imm_emit32 (fromIntegral disp)+       else do if (disp == 0 && (toInteger basereg) /= (toInteger x86_ebp))+                  then x86_address_byte 0 r basereg+                  else if x86_is_imm8 (fromIntegral disp)+                          then do x86_address_byte 1 r basereg+                                  x86_imm_emit8 (fromIntegral disp)+                          else do x86_address_byte 2 r basereg+                                  x86_imm_emit32 (fromIntegral disp)++x86_memindex_emit r basereg disp indexreg shift =+    if (basereg == x86_nobasereg)+       then do x86_address_byte 0 r 4+               x86_address_byte shift indexreg 5+               x86_imm_emit32 disp+       else if ((disp) == 0 && (basereg) /= x86_ebp)+               then do x86_address_byte 0 r 4+                       x86_address_byte shift indexreg (fromIntegral basereg)+                else if x86_is_imm8 disp+                        then do x86_address_byte 1 r 4+                                x86_address_byte shift indexreg +                                             (fromIntegral basereg)+                                x86_imm_emit8 (fromIntegral disp)+                        else do x86_address_byte 2 r 4+                                x86_address_byte shift indexreg 5+                                x86_imm_emit32 disp++x86_jmp_ofs_size ins =+  do instr <- peek8At ins+     case trace (show instr) instr of+       0xe8 -> return 1+       0xe9 -> return 1+       0x0f ->+         do atPos <- peek8At (ins + 1)+            if (atPos < 0x70 || atPos > 0x8f)+               then failCodeGen (PP.text "Wrong Opcode")+               else return 1+       _ -> return 0++-- target is the position in the code where to jump to:++-- target = code;+-- .. output loop code...+-- x86_mov_reg_imm (code, X86_EAX, 0);+-- loop = code;+-- x86_loop (code, -1);+-- ... finish method++-- patch displacement++-- x86_patch (loop, target);++-- ins should point at the start of the instruction that encodes a target.+-- the instruction is inspected for validity and the correct displacement+-- is inserted.++x86_patch ins target =+    let pos = ins + 1+    in do size <- x86_jmp_ofs_size ins+          instr <- peek8At ins+          let disp = target - (if instr == 0x0f then pos + 1 else pos)+          if size == 1+             then x86_imm_emit32_at pos (fromIntegral (disp - 4))+             else if (x86_is_imm8 (disp - 1)) +                     then x86_imm_emit8_at pos (fromIntegral (disp - 1))+                     else failCodeGen (PP.text "Wrong offset")++x86_breakpoint, x86_cld, x86_stosb, x86_stosl, x86_stosd, x86_movsb, + x86_movsl, x86_movsd :: CodeGen s e ()+x86_breakpoint = emit8 0xcc+x86_cld = emit8 0xfc+x86_stosb = emit8 0xaa+x86_stosl = emit8 0xab+x86_stosd = x86_stosl+x86_movsb = emit8 0xa4+x86_movsl = emit8 0xa5+x86_movsd = x86_movsl++x86_prefix :: Word8 -> CodeGen s e ()+x86_prefix p = emit8 p++x86_rdtsc :: CodeGen s e ()+x86_rdtsc = emit8 0x0f >> emit8 0x31++x86_cmpxchg_reg_reg dreg reg = +    emit8 0x0f >> emit8 0xb1 >> x86_reg_emit reg dreg+x86_cmpxchg_mem_reg mem reg = emit8 0x0f >> emit8 0xb1 >> x86_mem_emit reg mem+x86_cmpxchg_membase_reg basereg disp reg =+    emit8 0x0f >> emit8 0xb1 >> x86_membase_emit reg basereg disp++x86_xchg size = if size == 1 then emit8 0x86 else emit8 0x87+x86_xchg_reg_reg dreg reg size =+    do x86_xchg size ; x86_reg_emit reg dreg+x86_xchg_mem_reg mem reg size =+    do x86_xchg size ; x86_mem_emit reg mem+x86_xchg_membase_reg basereg disp reg size =+    do x86_xchg size ; x86_membase_emit reg basereg disp++x86_xadd size = +    do emit8 0x0f ; if size == 1 then emit8 0xc0 else emit8 0xc1+x86_xadd_reg_reg dreg reg size = x86_xadd size >> x86_reg_emit reg dreg+x86_xadd_mem_reg mem reg size = x86_xadd size >> x86_mem_emit reg mem+x86_xadd_membase_reg basereg disp reg size =+    x86_xadd size >> x86_membase_emit reg basereg disp++x86_inc_mem mem = emit8 0xff >> x86_mem_emit 0 mem+x86_inc_membase basereg disp = emit8 0xff >> x86_membase_emit 0 basereg disp+x86_inc_reg reg = emit8 (0x40 + reg)++x86_dec_mem mem = emit8 0xff >> x86_mem_emit 1 mem+x86_dec_membase basereg disp = emit8 0xff >> x86_membase_emit 1 basereg disp+x86_dec_reg reg = emit8 (0x48 + reg)++x86_not_mem mem = emit8 0xf7 >> x86_mem_emit 2 mem+x86_not_membase basereg disp = emit8 0xf7 >> x86_membase_emit 2 basereg disp+x86_not_reg reg = emit8 0xf7 >> x86_reg_emit 2 reg++x86_neg_mem mem = emit8 0xf7 >> x86_mem_emit 3 mem+x86_neg_membase basereg disp = emit8 0xf7 >> x86_membase_emit 3 basereg disp+x86_neg_reg reg = emit8 0xf7 >> x86_reg_emit 3 reg++x86_nop :: CodeGen s e ()+x86_nop = emit8 0x90++x86_alu_reg_imm :: Word8 -> Word8 -> Int -> CodeGen e s ()+x86_alu_reg_imm opc reg imm =+    do if reg == x86_eax+          then emit8 (fromIntegral (((opc) `shiftL` 3) + 5)) >> x86_imm_emit32 (fromIntegral imm)+          else if x86_is_imm8 imm+                  then do emit8 0x83+                          x86_reg_emit (fromIntegral opc) (fromIntegral reg)+                          x86_imm_emit8 (fromIntegral imm)+                  else do emit8 0x81+                          x86_reg_emit (fromIntegral opc) (fromIntegral reg)+                          x86_imm_emit32 (fromIntegral imm)+++x86_alu_mem_imm opc mem imm =+    if x86_is_imm8 imm+       then do emit8 0x83+               x86_mem_emit opc mem+               x86_imm_emit8 (fromIntegral imm)+       else do emit8 0x81+               x86_mem_emit opc mem+               x86_imm_emit32 imm+++x86_alu_membase_imm opc basereg disp imm =+    if x86_is_imm8 imm+       then do emit8 0x83+               x86_membase_emit opc basereg disp+               x86_imm_emit8 (fromIntegral imm)+       else do emit8 0x81+               x86_membase_emit opc basereg disp+               x86_imm_emit32 imm+x86_alu_membase8_imm opc basereg disp imm =+    do emit8 0x80+       x86_membase_emit opc basereg disp+       x86_imm_emit8 imm+x86_alu_mem_reg opc mem reg =+        do emit8 ((opc `shiftL` 3) + 1)+           x86_mem_emit reg mem+x86_alu_membase_reg opc basereg disp reg =+    do emit8 ((opc `shiftL` 3) + 1)+       x86_membase_emit reg basereg disp+x86_alu_reg_reg opc dreg reg =+    do emit8 ((opc `shiftL` 3) + 3)+       x86_reg_emit dreg reg++-- @x86_alu_reg8_reg8:+-- Supports ALU operations between two 8-bit registers.+-- dreg := dreg opc reg+-- X86_Reg_No enum is used to specify the registers.+-- Additionally is_*_h flags are used to specify what part+-- of a given 32-bit register is used - high (TRUE) or low (FALSE).+-- For example: dreg = X86_EAX, is_dreg_h = TRUE -> use AH++x86_alu_reg8_reg8 opc dreg reg is_dreg_h is_reg_h =+    do emit8 ((opc `shiftL` 3) + 2)+       x86_reg8_emit dreg reg is_dreg_h is_reg_h+x86_alu_reg_mem opc reg mem =+    do emit8 ((opc `shiftL` 3) + 3)+       x86_mem_emit reg mem+x86_alu_reg_membase opc reg basereg disp =+    do emit8 ((opc `shiftL` 3) + 3)+       x86_membase_emit reg basereg disp++x86_test_reg_imm reg imm =+    do if reg == x86_eax+          then emit8 0xa9+          else do emit8 0xf7 ; x86_reg_emit 0 (fromIntegral reg)+       x86_imm_emit32 imm+x86_test_mem_imm mem imm =+    do emit8 0xf7 ; x86_mem_emit 0 mem ; x86_imm_emit32 imm+x86_test_membase_imm basereg disp imm =+    do emit8 0xf7 ; x86_membase_emit 0 basereg disp ; x86_imm_emit32 imm+x86_test_reg_reg dreg reg = do emit8 0x85 ; x86_reg_emit reg dreg+x86_test_mem_reg mem reg =+    do emit8 0x85 ; x86_mem_emit reg mem+x86_test_membase_reg basereg disp reg =+    do emit8 0x85 ; x86_membase_emit reg basereg disp++x86_shift_reg_imm opc reg imm =+    if imm == 1+       then do emit8 0xd1 ; x86_reg_emit opc reg+       else do emit8 0xc1+               x86_reg_emit opc reg+               x86_imm_emit8 imm+x86_shift_mem_imm opc mem imm =+    if imm == 1+       then do emit8 0xd1 ; x86_mem_emit opc mem+       else do emit8 0xc1+               x86_mem_emit opc mem+               x86_imm_emit8 imm+x86_shift_membase_imm opc basereg disp imm =+    if imm == 1+       then do emit8 0xd1 ; x86_membase_emit opc basereg disp+       else do emit8 0xc1+               x86_membase_emit opc basereg disp+               x86_imm_emit8 imm+x86_shift_reg opc reg =+    emit8 0xd3 >> x86_reg_emit opc reg+x86_shift_mem opc mem =+    emit8 0xd3 >> x86_mem_emit opc mem+x86_shift_membase opc basereg disp =+    emit8 0xd3 >> x86_membase_emit opc basereg disp++-- Multi op shift missing.++x86_shrd_reg dreg reg =                     +    emit8 0x0f >> emit8 0xad >> x86_reg_emit reg dreg +x86_shrd_reg_imm dreg reg shamt =+    emit8 0x0f >> emit8 0xac >> x86_reg_emit reg dreg >> x86_imm_emit8 shamt+x86_shld_reg dreg reg =                     +    emit8 0x0f >> emit8 0xa5 >> x86_reg_emit reg dreg +x86_shld_reg_imm dreg reg shamt =+    emit8 0x0f >> emit8 0xa4 >> x86_reg_emit reg dreg >>x86_imm_emit8 shamt++-- EDX:EAX = EAX * rm++x86_mul_reg reg is_signed =   +    emit8 0xf7 >> x86_reg_emit (4 + (if is_signed then 1 else 0)) reg +x86_mul_mem mem is_signed =   +    emit8 0xf7 >> x86_mem_emit (4 + (if is_signed then 1 else 0)) mem +x86_mul_membase basereg disp is_signed =      +    do emit8 0xf7+       x86_membase_emit (4 + (if is_signed then 1 else 0)) basereg disp++-- r *= rm++x86_imul_reg_reg dreg reg =   +    emit8 0x0f >> emit8 0xaf >> x86_reg_emit dreg reg +x86_imul_reg_mem reg mem =    +    emit8 0x0f >> emit8 0xaf >> x86_mem_emit reg mem  +x86_imul_reg_membase reg basereg disp =       +    emit8 0x0f >> emit8 0xaf >> x86_membase_emit reg basereg disp     ++-- dreg = rm * imm++x86_imul_reg_reg_imm dreg reg imm =   +    if x86_is_imm8 imm+       then emit8 0x6b >> x86_reg_emit dreg reg >> +              x86_imm_emit8 (fromIntegral imm)        +       else emit8 0x69 >> x86_reg_emit dreg reg >> x86_imm_emit32 imm +x86_imul_reg_mem_imm reg mem imm =    +    if x86_is_imm8 imm+       then emit8 0x6b >> x86_mem_emit reg mem >> +              x86_imm_emit8 (fromIntegral imm)        +       else emit8 0x69 >> x86_reg_emit reg (fromIntegral mem) >> +              x86_imm_emit32 imm      +x86_imul_reg_membase_imm reg basereg disp imm =       +    if x86_is_imm8 imm+       then emit8 0x6b >> x86_membase_emit reg basereg disp >> +            x86_imm_emit8 (fromIntegral imm)+       else do emit8 0x69+               x86_membase_emit reg basereg disp      +               x86_imm_emit32 imm     ++-- divide EDX:EAX by rm;+-- eax = quotient, edx = remainder++x86_div_reg reg is_signed =   +    emit8 0xf7 >> x86_reg_emit (6 + (if is_signed then 1 else 0)) reg +x86_div_mem mem is_signed =   +    emit8 0xf7 >> x86_mem_emit (6 + (if is_signed then 1 else 0)) mem +x86_div_membase basereg disp is_signed =      +    do emit8 0xf7+       x86_membase_emit (6 + (if is_signed then 1 else 0)) basereg disp++x86_mov1 size =+    case size of+         1 -> emit8 0x88+         2 -> emit8 0x66 >> emit8 0x89+         4 -> emit8 0x89+         _ -> failCodeGen (PP.text "invalid operand size")+       +x86_mov2 size =+    case size of+         1 -> emit8 0x8a+         2 -> emit8 0x66 >> emit8 0x8b+         4 -> emit8 0x8b+         _ -> failCodeGen (PP.text "invalid operand size")+       +x86_mov_mem_reg mem reg size =        +    do x86_mov1 size ; x86_mem_emit reg mem   +x86_mov_regp_reg regp reg size =      +    do x86_mov1 size ; x86_regp_emit reg regp+x86_mov_reg_regp reg regp size =      +    do x86_mov2 size ; x86_regp_emit reg regp+x86_mov_membase_reg basereg disp reg size =   +    do x86_mov1 size ; x86_membase_emit reg basereg disp      +x86_mov_memindex_reg basereg disp indexreg shift reg size =   +    do x86_mov1 size ; x86_memindex_emit reg basereg disp indexreg shift+x86_mov_reg_reg dreg reg size =       +    do x86_mov2 size+       x86_reg_emit dreg reg  +x86_mov_reg_mem reg mem size =        +    do x86_mov2 size+       x86_mem_emit reg mem   +x86_mov_reg_membase reg basereg disp size =+    do x86_mov2 size+       x86_membase_emit reg basereg disp      +x86_mov_reg_memindex reg basereg disp 4 shift size =+    failCodeGen $ PP.text "x86_mov_reg_memindex: cannot use (E)SP as index register"+x86_mov_reg_memindex reg basereg disp indexreg shift size =   +    do x86_mov2 size+       x86_memindex_emit reg basereg disp indexreg  shift     ++-- Note: x86_clear_reg () changes the condition code!++x86_clear_reg reg = x86_alu_reg_reg x86_xor reg reg++x86_mov_reg_imm reg imm =     +    emit8 (0xb8 + reg) >> x86_imm_emit32 imm  +x86_mov_mem_imm mem imm size =        +    if size == 1+       then do emit8 0xc6;    +               x86_mem_emit 0 mem     +               x86_imm_emit8 (fromIntegral imm)       +       else if size == 2+               then do emit8 0x66+                       emit8 0xc7+                       x86_mem_emit 0 mem     +                       x86_imm_emit16 (fromIntegral imm)      +               else do emit8 0xc7+                       x86_mem_emit 0 mem     +                       x86_imm_emit32 imm     +x86_mov_membase_imm basereg disp imm size =   +    if size == 1+       then do emit8 0xc6     +               x86_membase_emit 0 basereg disp+               x86_imm_emit8 (fromIntegral imm)+       else if size == 2+               then do emit8 0x66     +                       emit8 0xc7+                       x86_membase_emit 0 basereg disp        +                       x86_imm_emit16 (fromIntegral imm)      +               else do emit8 0xc7     +                       x86_membase_emit 0 basereg disp        +                       x86_imm_emit32 imm     ++x86_mov_memindex_imm basereg disp indexreg shift imm size =   +    if size == 1+    then do emit8 0xc6        +            x86_memindex_emit 0 basereg disp indexreg  shift  +            x86_imm_emit8 (fromIntegral imm)  +    else if size == 2+         then do emit8 0x66   +                 emit8 0xc7   +                 x86_memindex_emit 0 basereg disp indexreg  shift     +                 x86_imm_emit16 (fromIntegral imm)    +         else do emit8 0xc7   +                 x86_memindex_emit 0 basereg disp indexreg  shift     +                 x86_imm_emit32 imm   ++-- LEA: Load Effective Address++x86_lea_mem reg mem = emit8 0x8d >> x86_mem_emit reg mem      +x86_lea_membase reg basereg disp =    +    emit8 0x8d >> x86_membase_emit reg basereg disp   +x86_lea_memindex reg basereg disp indexreg shift =+    emit8 0x8d >> x86_memindex_emit reg basereg disp indexreg shift   ++x86_widen_reg dreg reg is_signed is_half =+    if is_half || x86_is_byte_reg reg+    then do let op = 0xb6 + (if is_signed then 0x08 else 0) ++                     (if is_half then 0x1 else 0)+            emit8 0x0f+            emit8 op+            x86_reg_emit dreg reg+    else failCodeGen (PP.text "widen: need byte register or is_half=True")+x86_widen_mem dreg mem is_signed is_half =+    do let op = 0xb6 + (if is_signed then 0x08 else 0) ++                (if is_half then 0x1 else 0)+       emit8 0x0f+       emit8 op+       x86_mem_emit dreg mem  +x86_widen_membase dreg basereg disp is_signed is_half =       +    do let op = 0xb6 + (if is_signed then 0x08 else 0) ++                (if is_half then 0x1 else 0)+       emit8 0x0f+       emit8 op+       x86_membase_emit dreg basereg disp     +x86_widen_memindex dreg basereg disp indexreg shift is_signed is_half =+    do let op = 0xb6 + (if is_signed then 0x08 else 0) ++                (if is_half then 0x1 else 0)+       emit8 0x0f+       emit8 op+       x86_memindex_emit dreg basereg disp indexreg shift     ++x86_cdq, x86_wait :: CodeGen s e ()+x86_cdq  = emit8 0x99+x86_wait = emit8 0x9b++x86_fp_op_mem opc mem is_double =     +    do emit8 (if is_double then 0xdc else 0xd8)       +       x86_mem_emit opc mem+x86_fp_op_membase opc basereg disp is_double =        +    do emit8 (if is_double then 0xdc else 0xd8)       +       x86_membase_emit opc basereg disp      +x86_fp_op opc index = +    do emit8 0xd8+       emit8 (0xc0 + (opc `shiftL` 3) + (index .&. 0x07))+x86_fp_op_reg opc index pop_stack =   +    do let  map = [ 0, 1, 2, 3, 5, 4, 7, 6, 8]        +       emit8 (if pop_stack then 0xde else 0xdc)       +       emit8 (0xc0 + ((map !! opc) `shiftL` 3) + (index .&. 0x07))+++-- @x86_fp_int_op_membase+-- Supports FPU operations between ST(0) and integer operand in memory.+-- Operation encoded using X86_FP_Opcode enum.+-- Operand is addressed by [basereg + disp].+-- is_int specifies whether operand is int32 (TRUE) or int16 (FALSE).++x86_fp_int_op_membase opc basereg disp is_int =+    do emit8 (if is_int then 0xda else 0xde)  +       x86_membase_emit opc basereg disp      +x86_fstp index =      +    emit8 0xdd >> emit8 (0xd8 + index)        +x86_fcompp = emit8 0xde >> emit8 0xd9 +x86_fucompp = emit8 0xda >> emit8 0xe9        +x86_fnstsw = emit8 0xdf >> emit8 0xe0 +x86_fnstcw mem = emit8 0xd9 >> x86_mem_emit 7 mem     +x86_fnstcw_membase basereg disp =     +    emit8 0xd9 >> x86_membase_emit 7 basereg disp     +x86_fldcw mem = emit8 0xd9 >> x86_mem_emit 5 mem      +x86_fldcw_membase basereg disp =      +    emit8 0xd9 >> x86_membase_emit 5 basereg disp     +x86_fchs = emit8 0xd9 >> emit8 0xe0   +x86_frem = emit8 0xd9 >> emit8 0xf8+x86_fxch index = emit8 0xd9 >> emit8 (0xc8 + (index .&. 0x07))        +x86_fcomi index = emit8 0xdb >> emit8 (0xf0 + (index .&. 0x07))       +x86_fcomip index = emit8 0xdf >> emit8 (0xf0 + (index .&. 0x07))      +x86_fucomi index = emit8 0xdb >> emit8 (0xe8 + (index .&. 0x07))+x86_fucomip index = emit8 0xdf >> emit8 (0xe8 + (index .&. 0x07))+x86_fld mem is_double =       +    do emit8 (if is_double then 0xdd else 0xd9)       +       x86_mem_emit 0 mem     +x86_fld_membase basereg disp is_double =      +    do emit8 (if is_double then 0xdd else 0xd9)       +       x86_membase_emit 0 basereg disp        +x86_fld80_mem mem = emit8 0xdb >> x86_mem_emit 5 mem  +x86_fld80_membase basereg disp =      +    emit8 0xdb >> x86_membase_emit 5 basereg disp     +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 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_fld_reg index =   +    emit8 0xd9 >> emit8 (0xc0 + (index .&. 0x07))+x86_fldz = emit8 0xd9 >> emit8 0xee   +x86_fld1 = emit8 0xd9 >> emit8 0xe8+x86_fldpi = emit8 0xd9 >> emit8 0xeb  ++x86_fst mem is_double pop_stack =     +    do emit8 (if is_double then 0xdd else 0xd9)+       x86_mem_emit (2 + (if pop_stack then 1 else 0)) mem    +x86_fst_membase basereg disp is_double pop_stack =    +    do emit8 (if is_double then 0xdd else 0xd9)       +       x86_membase_emit (2 + (if pop_stack then 1 else 0)) basereg disp+x86_fst80_mem mem = emit8 0xdb >> x86_mem_emit 7 mem  +x86_fst80_membase basereg disp =      +    emit8 0xdb >> x86_membase_emit 7 basereg disp     +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 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_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).++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     ++-- PUSH instruction.++x86_push_reg reg = emit8 (0x50 + reg) +x86_push_regp reg = emit8 0xff >> x86_regp_emit 6 reg +x86_push_mem mem = emit8 0xff >> x86_mem_emit 6 mem   +x86_push_membase basereg disp = +    emit8 0xff >> x86_membase_emit 6 basereg disp     +x86_push_memindex basereg disp indexreg shift =+    emit8 0xff >> x86_memindex_emit 6 basereg disp indexreg shift     +x86_push_imm_template = x86_push_imm 0xf0f0f0f0+x86_push_imm imm =    +    if x86_is_imm8 imm+    then emit8 0x6A >> x86_imm_emit8 (fromIntegral imm)+    else emit8 0x68 >> x86_imm_emit32 imm++-- POP instruction.++x86_pop_reg reg = emit8 (0x58 + reg)+x86_pop_mem mem = emit8 0x87 >> x86_mem_emit 0 mem    +x86_pop_membase basereg disp =        +    emit8 0x87 >> x86_membase_emit 0 basereg disp     ++x86_pushad = emit8 0x60+x86_pushfd = emit8 0x9c+x86_popad  = emit8 0x61+x86_popfd  = emit8 0x9d++x86_loop imm = emit8 0xe2 >> x86_imm_emit8 imm        +x86_loope imm = emit8 0xe1 >> x86_imm_emit8 imm       +x86_loopne imm = emit8 0xe0 >> x86_imm_emit8 imm      ++x86_jump32 imm = emit8 0xe9 >> x86_imm_emit32 imm     +x86_jump8 imm = emit8 0xeb >> x86_imm_emit8 imm       +x86_jump_reg reg = emit8 0xff >> x86_reg_emit 4 reg   +x86_jump_mem mem = emit8 0xff >> x86_mem_emit 4 mem   +x86_jump_membase basereg disp =       +    emit8 0xff >> x86_membase_emit 4 basereg disp     ++-- target is a pointer in our buffer.++x86_jump_code target =+    do inst <- getCodeOffset+       let t = target - inst - 2      +       if x86_is_imm8 t+          then x86_jump8 (fromIntegral t)+          else x86_jump32 (fromIntegral (t - 3))+x86_jump_disp disp =  +    do let t = disp - 2+       if x86_is_imm8 t+          then x86_jump8 (fromIntegral t)+          else x86_jump32 (t - 3)++x86_branch8 cond imm is_signed =      +    do if is_signed   +          then emit8 (x86_cc_signed_map !! cond)+          else emit8 (x86_cc_unsigned_map !! cond)    +       x86_imm_emit8 imm      +x86_branch32 cond imm is_signed =     +    do emit8 0x0f     +       if is_signed   +          then emit8 ((x86_cc_signed_map !! cond) + 0x10)     +          else emit8 ((x86_cc_unsigned_map !! cond) + 0x10)   +       x86_imm_emit32 imm     ++x86_branch cond target is_signed =    +    do inst <- getCodeOffset+       let offset = target - inst - 2;        +       if x86_is_imm8 offset+          then x86_branch8 cond (fromIntegral offset) is_signed+          else x86_branch32 cond (fromIntegral (offset - 4)) is_signed++x86_branch_disp cond disp is_signed = +    do let offset = disp - 2+       if x86_is_imm8 offset+          then x86_branch8 cond (fromIntegral offset) is_signed+          else x86_branch32 cond (offset - 4) is_signed++x86_jecxz imm = emit8 0xe3 >> emit8 imm++x86_set_reg cond reg is_signed =      +    do emit8 0x0f     +       if is_signed+          then emit8 ((x86_cc_signed_map !! cond) + 0x20)     +          else emit8 ((x86_cc_unsigned_map !! cond) + 0x20)   +       x86_reg_emit 0 reg     ++x86_set_mem cond mem is_signed =      +    do emit8 0x0f     +       if is_signed+          then emit8 ((x86_cc_signed_map !! cond) + 0x20)     +          else emit8 ((x86_cc_unsigned_map !! cond) + 0x20)   +       x86_mem_emit 0 mem     +x86_set_membase cond basereg disp is_signed = +    do emit8 0x0f     +       if is_signed+          then emit8 ((x86_cc_signed_map !! cond) + 0x20)     +          else emit8 ((x86_cc_unsigned_map !! cond) + 0x20)   +       x86_membase_emit 0 basereg disp        ++-- Call instructions.++x86_call_imm :: Word32 -> CodeGen s e ()+x86_call_imm disp = emit8 0xe8 >> x86_imm_emit32 disp ++x86_call_reg :: Word8 -> CodeGen s e ()+x86_call_reg reg = emit8 0xff >> x86_reg_emit 2 reg++x86_call_mem :: Word32 -> CodeGen s e ()+x86_call_mem mem = emit8 0xff >> x86_mem_emit 2 mem   ++x86_call_membase :: Word8 -> Word32 -> CodeGen s e ()+x86_call_membase basereg disp =       +    emit8 0xff >> x86_membase_emit 2 basereg disp     ++x86_call_code :: Int -> CodeGen s e ()+x86_call_code target =        +    do inst <- getCodeOffset+       let  _x86_offset = (target - inst - 5)+       x86_call_imm (fromIntegral _x86_offset)++x86_call_hs :: FunPtr a -> CodeGen e s ()+x86_call_hs fptr = do { offset <- getCodeOffset+                      ; base <- getBasePtr+                      ; emitRelocInfo (offset + 1)+                          RelocPCRel fptr+                      ; x86_call_imm $ (fromIntegral (minusPtr (castFunPtrToPtr fptr) (plusPtr base offset) - 5))+                      }++-- RET instruction.++x86_ret :: CodeGen s e ()+x86_ret = emit8 0xc3++x86_ret_imm :: Word16 -> CodeGen s e ()+x86_ret_imm imm =     +    if imm == 0 then x86_ret else emit8 0xc2 >> x86_imm_emit16 imm    ++-- Conditional move instructions.++x86_cmov cond is_signed =+    do emit8 0x0f     +       if is_signed+          then emit8 ((x86_cc_signed_map !! cond) - 0x30)+          else emit8 ((x86_cc_unsigned_map !! cond) - 0x30)+x86_cmov_reg cond is_signed dreg reg =        +    do x86_cmov cond is_signed+       x86_reg_emit dreg reg  +x86_cmov_mem cond is_signed reg mem = +    do x86_cmov cond is_signed+       x86_mem_emit reg mem   +x86_cmov_membase cond is_signed reg basereg disp =    +    do x86_cmov cond is_signed+       x86_membase_emit reg basereg disp      ++-- Note: definition for ENTER instruction is not complete.  The counter+-- for the display setup is set to 0.++x86_enter :: Word16 -> CodeGen s e ()+x86_enter framesize = emit8 0xc8 >> x86_imm_emit16 framesize >> emit8 0++x86_leave :: CodeGen s e ()+x86_leave = emit8 0xc9++x86_sahf :: CodeGen s e ()+x86_sahf  = emit8 0x9e++-- Trigonometric floating point functions++x86_fsin, x86_fcos, x86_fabs, x86_ftst, x86_fxam, x86_fpatan, + x86_fprem, x86_fprem1, x86_frndint, x86_fsqrt, x86_fptan :: CodeGen s e ()+x86_fsin    = emit8 0xd9 >> emit8 0xfe+x86_fcos    = emit8 0xd9 >> emit8 0xff+x86_fabs    = emit8 0xd9 >> emit8 0xe1+x86_ftst    = emit8 0xd9 >> emit8 0xe4+x86_fxam    = emit8 0xd9 >> emit8 0xe5+x86_fpatan  = emit8 0xd9 >> emit8 0xf3+x86_fprem   = emit8 0xd9 >> emit8 0xf8+x86_fprem1  = emit8 0xd9 >> emit8 0xf5+x86_frndint = emit8 0xd9 >> emit8 0xfc+x86_fsqrt   = emit8 0xd9 >> emit8 0xfa+x86_fptan   = emit8 0xd9 >> emit8 0xf2++-- Fast instruction sequences for 1 to 7-byte noops.++x86_padding size =    +    case size of+      1 -> x86_nop+      2 -> emit8 0x8b >> emit8  0xc0+      3 -> emit8 0x8d >> emit8 0x6d >> emit8 0x00+      4 -> emit8 0x8d >> emit8 0x64 >> emit8 0x24 >> emit8 0x00       +      5 -> emit8 0x8d >> emit8 0x64 >> emit8 0x24 >> emit8 0x00 >>+           x86_nop  +      6 -> emit8 0x8d >> emit8 0xad >>        +           emit8 0x00 >> emit8 0x00 >>        +           emit8 0x00 >> emit8 0x00+      7 -> emit8 0x8d >> emit8 0xa4 >>        +           emit8 0x24 >> emit8 0x00 >>        +           emit8 0x00 >> emit8 0x00 >>        +           emit8 0x00+      _ -> failCodeGen (PP.text "invalid padding size")++-- Generate the code for a function prologue.  The frame_size is the+-- number of bytes to be allocated as the frame size, and the reg_mask+-- specifies which registers to save on function entry.++x86_prolog :: Int -> Int -> CodeGen e s ()+x86_prolog frame_size reg_mask =      +    do x86_push_reg x86_ebp+       x86_mov_reg_reg x86_ebp x86_esp x86_dword_size+       gen_push 0 1+       if frame_size /= 0 +          then x86_alu_reg_imm x86_sub x86_esp frame_size+          else return ()+  where+  gen_push i m =+     if i <= x86_edi+        then do if (reg_mask .&. m) /= 0+                   then x86_push_reg i+                   else return ()+                gen_push (i + 1) (m `shiftL` 1)+        else return ()++-- Opposite to x86_prolog: destroys the stack frame and restores the+-- registers in reg_mask, which should be the same as the register mask+-- used on function entry.++x86_epilog :: Int -> CodeGen e s ()+x86_epilog reg_mask =+    do gen_pop x86_edi (1 `shiftL` (fromIntegral x86_edi))+       x86_mov_reg_reg x86_esp x86_ebp x86_dword_size+       x86_pop_reg x86_ebp+       x86_ret+  where+  gen_pop i m =+    if m /= 0+       then do if (reg_mask .&. m) /= 0+                  then x86_pop_reg i+                  else return ()+               gen_pop (i - 1) (m `shiftR` 1)+       else return ()++-- TODO: Move signatures to definition, delete duplicates.+x86_cmpxchg_reg_reg ::+  forall e s.+  Word8+  -> Word8+  -> Harpy.CodeGenMonad.CodeGen e s ()+x86_cmpxchg_mem_reg ::+  forall e s.+  Word32+  -> Word8+  -> Harpy.CodeGenMonad.CodeGen e s ()+x86_cmpxchg_membase_reg ::+  forall e s.+  Word8+  -> Word32+  -> Word8+  -> Harpy.CodeGenMonad.CodeGen e s ()+x86_xchg_reg_reg ::+  forall a e s.+  (Num a) =>+  Word8+  -> Word8+  -> a+  -> Harpy.CodeGenMonad.CodeGen e s ()+x86_xchg_mem_reg ::+  forall a e s.+  (Num a) =>+  Word32+  -> Word8+  -> a+  -> Harpy.CodeGenMonad.CodeGen e s ()+x86_xchg_membase_reg ::+  forall a e s.+  (Num a) =>+  Word8+  -> Word32+  -> Word8+  -> a+  -> Harpy.CodeGenMonad.CodeGen e s ()+x86_xadd_reg_reg ::+  forall a e s.+  (Num a) =>+  Word8+  -> Word8+  -> a+  -> Harpy.CodeGenMonad.CodeGen e s ()+x86_xadd_mem_reg ::+  forall a e s.+  (Num a) =>+  Word32+  -> Word8+  -> a+  -> Harpy.CodeGenMonad.CodeGen e s ()+x86_xadd_membase_reg ::+  forall a e s.+  (Num a) =>+  Word8+  -> Word32+  -> Word8+  -> a+  -> Harpy.CodeGenMonad.CodeGen e s ()+x86_inc_mem ::+  forall e s. Word32 -> Harpy.CodeGenMonad.CodeGen e s ()+x86_inc_membase ::+  forall e s.+  Word8+  -> Word32+  -> Harpy.CodeGenMonad.CodeGen e s ()+x86_inc_reg ::+  forall e s. Word8 -> Harpy.CodeGenMonad.CodeGen e s ()+x86_dec_mem ::+  forall e s. Word32 -> Harpy.CodeGenMonad.CodeGen e s ()+x86_dec_membase ::+  forall e s.+  Word8+  -> Word32+  -> Harpy.CodeGenMonad.CodeGen e s ()+x86_dec_reg ::+  forall e s. Word8 -> Harpy.CodeGenMonad.CodeGen e s ()+x86_not_mem ::+  forall e s. Word32 -> Harpy.CodeGenMonad.CodeGen e s ()+x86_not_membase ::+  forall e s.+  Word8+  -> Word32+  -> Harpy.CodeGenMonad.CodeGen e s ()+x86_not_reg ::+  forall e s. Word8 -> Harpy.CodeGenMonad.CodeGen e s ()+x86_neg_mem ::+  forall e s. Word32 -> Harpy.CodeGenMonad.CodeGen e s ()+x86_neg_membase ::+  forall e s.+  Word8+  -> Word32+  -> Harpy.CodeGenMonad.CodeGen e s ()+x86_neg_reg ::+  forall e s. Word8 -> Harpy.CodeGenMonad.CodeGen e s ()+x86_alu_mem_imm ::+  forall e s.+  Word8+  -> Word32+  -> Word32+  -> Harpy.CodeGenMonad.CodeGen e s ()+x86_alu_membase_imm ::+  forall e s.+  Word8+  -> Word8+  -> Word32+  -> Word32+  -> Harpy.CodeGenMonad.CodeGen e s ()+x86_alu_membase8_imm ::+  forall e s.+  Word8+  -> Word8+  -> Word32+  -> Word8+  -> Harpy.CodeGenMonad.CodeGen e s ()+x86_alu_mem_reg ::+  forall e s.+  Word8+  -> Word32+  -> Word8+  -> Harpy.CodeGenMonad.CodeGen e s ()+x86_alu_membase_reg ::+  forall e s.+  Word8+  -> Word8+  -> Word32+  -> Word8+  -> Harpy.CodeGenMonad.CodeGen e s ()+x86_alu_reg_reg ::+  forall e s.+  Word8+  -> Word8+  -> Word8+  -> Harpy.CodeGenMonad.CodeGen e s ()+x86_alu_reg8_reg8 ::+  forall e s.+  Word8+  -> Word8+  -> Word8+  -> Bool+  -> Bool+  -> Harpy.CodeGenMonad.CodeGen e s ()+x86_alu_reg_mem ::+  forall e s.+  Word8+  -> Word8+  -> Word32+  -> Harpy.CodeGenMonad.CodeGen e s ()+x86_alu_reg_membase ::+  forall e s.+  Word8+  -> Word8+  -> Word8+  -> Word32+  -> Harpy.CodeGenMonad.CodeGen e s ()+x86_test_reg_imm ::+  forall e s.+  Word8+  -> Word32+  -> Harpy.CodeGenMonad.CodeGen e s ()+x86_test_mem_imm ::+  forall e s.+  Word32+  -> Word32+  -> Harpy.CodeGenMonad.CodeGen e s ()+x86_test_membase_imm ::+  forall e s.+  Word8+  -> Word32+  -> Word32+  -> Harpy.CodeGenMonad.CodeGen e s ()+x86_test_reg_reg ::+  forall e s.+  Word8+  -> Word8+  -> Harpy.CodeGenMonad.CodeGen e s ()+x86_test_mem_reg ::+  forall e s.+  Word32+  -> Word8+  -> Harpy.CodeGenMonad.CodeGen e s ()+x86_test_membase_reg ::+  forall e s.+  Word8+  -> Word32+  -> Word8+  -> Harpy.CodeGenMonad.CodeGen e s ()+x86_shift_reg_imm ::+  forall e s.+  Word8+  -> Word8+  -> Word8+  -> Harpy.CodeGenMonad.CodeGen e s ()+x86_shift_mem_imm ::+  forall e s.+  Word8+  -> Word32+  -> Word8+  -> Harpy.CodeGenMonad.CodeGen e s ()+x86_shift_membase_imm ::+  forall e s.+  Word8+  -> Word8+  -> Word32+  -> Word8+  -> Harpy.CodeGenMonad.CodeGen e s ()+x86_shift_reg ::+  forall e s.+  Word8+  -> Word8+  -> Harpy.CodeGenMonad.CodeGen e s ()+x86_shift_mem ::+  forall e s.+  Word8+  -> Word32+  -> Harpy.CodeGenMonad.CodeGen e s ()+x86_shift_membase ::+  forall e s.+  Word8+  -> Word8+  -> Word32+  -> Harpy.CodeGenMonad.CodeGen e s ()+x86_shrd_reg ::+  forall e s.+  Word8+  -> Word8+  -> Harpy.CodeGenMonad.CodeGen e s ()+x86_shrd_reg_imm ::+  forall e s.+  Word8+  -> Word8+  -> Word8+  -> Harpy.CodeGenMonad.CodeGen e s ()+x86_shld_reg ::+  forall e s.+  Word8+  -> Word8+  -> Harpy.CodeGenMonad.CodeGen e s ()+x86_shld_reg_imm ::+  forall e s.+  Word8+  -> Word8+  -> Word8+  -> Harpy.CodeGenMonad.CodeGen e s ()+x86_mul_reg ::+  forall e s.+  Word8 -> Bool -> Harpy.CodeGenMonad.CodeGen e s ()+x86_mul_mem ::+  forall e s.+  Word32 -> Bool -> Harpy.CodeGenMonad.CodeGen e s ()+x86_mul_membase ::+  forall e s.+  Word8+  -> Word32+  -> Bool+  -> Harpy.CodeGenMonad.CodeGen e s ()+x86_imul_reg_reg ::+  forall e s.+  Word8+  -> Word8+  -> Harpy.CodeGenMonad.CodeGen e s ()+x86_imul_reg_mem ::+  forall e s.+  Word8+  -> Word32+  -> Harpy.CodeGenMonad.CodeGen e s ()+x86_imul_reg_membase ::+  forall e s.+  Word8+  -> Word8+  -> Word32+  -> Harpy.CodeGenMonad.CodeGen e s ()+x86_imul_reg_reg_imm ::+  forall e s.+  Word8+  -> Word8+  -> Word32+  -> Harpy.CodeGenMonad.CodeGen e s ()+x86_imul_reg_mem_imm ::+  forall e s.+  Word8+  -> Word32+  -> Word32+  -> Harpy.CodeGenMonad.CodeGen e s ()+x86_imul_reg_membase_imm ::+  forall e s.+  Word8+  -> Word8+  -> Word32+  -> Word32+  -> Harpy.CodeGenMonad.CodeGen e s ()+x86_div_reg ::+  forall e s.+  Word8 -> Bool -> Harpy.CodeGenMonad.CodeGen e s ()+x86_div_mem ::+  forall e s.+  Word32 -> Bool -> Harpy.CodeGenMonad.CodeGen e s ()+x86_div_membase ::+  forall e s.+  Word8+  -> Word32+  -> Bool+  -> Harpy.CodeGenMonad.CodeGen e s ()+x86_mov_mem_reg ::+  forall t e s.+  (Num t) =>+  Word32+  -> Word8+  -> t+  -> Harpy.CodeGenMonad.CodeGen e s ()+x86_mov_regp_reg ::+  forall t e s.+  (Num t) =>+  Word8+  -> Word8+  -> t+  -> Harpy.CodeGenMonad.CodeGen e s ()+x86_mov_reg_regp ::+  forall t e s.+  (Num t) =>+  Word8+  -> Word8+  -> t+  -> Harpy.CodeGenMonad.CodeGen e s ()+x86_mov_membase_reg ::+  forall t e s.+  (Num t) =>+  Word8+  -> Word32+  -> Word8+  -> t+  -> Harpy.CodeGenMonad.CodeGen e s ()+x86_mov_memindex_reg ::+  forall t e s.+  (Num t) =>+  Word8+  -> Word32+  -> Word8+  -> Word8+  -> Word8+  -> t+  -> Harpy.CodeGenMonad.CodeGen e s ()+x86_mov_reg_reg ::+  forall t e s.+  (Num t) =>+  Word8+  -> Word8+  -> t+  -> Harpy.CodeGenMonad.CodeGen e s ()+x86_mov_reg_mem ::+  forall t e s.+  (Num t) =>+  Word8+  -> Word32+  -> t+  -> Harpy.CodeGenMonad.CodeGen e s ()+x86_mov_reg_membase ::+  forall t e s.+  (Num t) =>+  Word8+  -> Word8+  -> Word32+  -> t+  -> Harpy.CodeGenMonad.CodeGen e s ()+x86_mov_reg_memindex ::+  forall e s t.+  (Num t) =>+  Word8+  -> Word8+  -> Word32+  -> Word8+  -> Word8+  -> t+  -> Harpy.CodeGenMonad.CodeGen e s ()+x86_mov_reg_imm ::+  forall e s.+  Word8+  -> Word32+  -> Harpy.CodeGenMonad.CodeGen e s ()+x86_mov_mem_imm ::+  forall a e s.+  (Num a) =>+  Word32+  -> Word32+  -> a+  -> Harpy.CodeGenMonad.CodeGen e s ()+x86_mov_membase_imm ::+  forall a e s.+  (Num a) =>+  Word8+  -> Word32+  -> Word32+  -> a+  -> Harpy.CodeGenMonad.CodeGen e s ()+x86_mov_memindex_imm ::+  forall a e s.+  (Num a) =>+  Word8+  -> Word32+  -> Word8+  -> Word8+  -> Word32+  -> a+  -> Harpy.CodeGenMonad.CodeGen e s ()+x86_lea_mem ::+  forall e s.+  Word8+  -> Word32+  -> Harpy.CodeGenMonad.CodeGen e s ()+x86_lea_membase ::+  forall e s.+  Word8+  -> Word8+  -> Word32+  -> Harpy.CodeGenMonad.CodeGen e s ()+x86_lea_memindex ::+  forall e s.+  Word8+  -> Word8+  -> Word32+  -> Word8+  -> Word8+  -> Harpy.CodeGenMonad.CodeGen e s ()+x86_widen_reg ::+  forall e s.+  Word8+  -> Word8+  -> Bool+  -> Bool+  -> Harpy.CodeGenMonad.CodeGen e s ()+x86_widen_mem ::+  forall e s.+  Word8+  -> Word32+  -> Bool+  -> Bool+  -> Harpy.CodeGenMonad.CodeGen e s ()+x86_widen_membase ::+  forall e s.+  Word8+  -> Word8+  -> Word32+  -> Bool+  -> Bool+  -> Harpy.CodeGenMonad.CodeGen e s ()+x86_widen_memindex ::+  forall e s.+  Word8+  -> Word8+  -> Word32+  -> Word8+  -> Word8+  -> Bool+  -> Bool+  -> Harpy.CodeGenMonad.CodeGen e s ()+x86_push_reg ::+  forall e s. Word8 -> Harpy.CodeGenMonad.CodeGen e s ()+x86_push_regp ::+  forall e s. Word8 -> Harpy.CodeGenMonad.CodeGen e s ()+x86_push_mem ::+  forall e s. Word32 -> Harpy.CodeGenMonad.CodeGen e s ()+x86_push_membase ::+  forall e s.+  Word8+  -> Word32+  -> Harpy.CodeGenMonad.CodeGen e s ()+x86_push_memindex ::+  forall e s.+  Word8+  -> Word32+  -> Word8+  -> Word8+  -> Harpy.CodeGenMonad.CodeGen e s ()+x86_push_imm_template ::+  forall e s. Harpy.CodeGenMonad.CodeGen e s ()+x86_push_imm ::+  forall e s. Word32 -> Harpy.CodeGenMonad.CodeGen e s ()+x86_pop_reg ::+  forall e s. Word8 -> Harpy.CodeGenMonad.CodeGen e s ()+x86_pop_mem ::+  forall e s. Word32 -> Harpy.CodeGenMonad.CodeGen e s ()+x86_pop_membase ::+  forall e s.+  Word8+  -> Word32+  -> Harpy.CodeGenMonad.CodeGen e s ()+x86_pushad :: forall e s. Harpy.CodeGenMonad.CodeGen e s ()+x86_pushfd :: forall e s. Harpy.CodeGenMonad.CodeGen e s ()+x86_popad :: forall e s. Harpy.CodeGenMonad.CodeGen e s ()+x86_popfd :: forall e s. Harpy.CodeGenMonad.CodeGen e s ()+x86_loop ::+  forall e s. Word8 -> Harpy.CodeGenMonad.CodeGen e s ()+x86_loope ::+  forall e s. Word8 -> Harpy.CodeGenMonad.CodeGen e s ()+x86_loopne ::+  forall e s. Word8 -> Harpy.CodeGenMonad.CodeGen e s ()+x86_jump32 ::+  forall e s. Word32 -> Harpy.CodeGenMonad.CodeGen e s ()+x86_jump8 ::+  forall e s. Word8 -> Harpy.CodeGenMonad.CodeGen e s ()+x86_jump_reg ::+  forall e s. Word8 -> Harpy.CodeGenMonad.CodeGen e s ()+x86_jump_mem ::+  forall e s. Word32 -> Harpy.CodeGenMonad.CodeGen e s ()+x86_jump_membase ::+  forall e s.+  Word8+  -> Word32+  -> Harpy.CodeGenMonad.CodeGen e s ()+x86_branch8 ::+  forall e s.+  Int -> Word8 -> Bool -> Harpy.CodeGenMonad.CodeGen e s ()+x86_branch32 ::+  forall e s.+  Int -> Word32 -> Bool -> Harpy.CodeGenMonad.CodeGen e s ()+x86_branch ::+  forall e s. Int -> Int -> Bool -> Harpy.CodeGenMonad.CodeGen e s ()+x86_jecxz ::+  forall e s. Word8 -> Harpy.CodeGenMonad.CodeGen e s ()+x86_set_reg ::+  forall e s.+  Int -> Word8 -> Bool -> Harpy.CodeGenMonad.CodeGen e s ()+x86_set_mem ::+  forall e s.+  Int -> Word32 -> Bool -> Harpy.CodeGenMonad.CodeGen e s ()+x86_set_membase ::+  forall e s.+  Int+  -> Word8+  -> Word32+  -> Bool+  -> Harpy.CodeGenMonad.CodeGen e s ()+x86_cmov_reg ::+  forall e s.+  Int+  -> Bool+  -> Word8+  -> Word8+  -> Harpy.CodeGenMonad.CodeGen e s ()+x86_cmov_mem ::+  forall e s.+  Int+  -> Bool+  -> Word8+  -> Word32+  -> Harpy.CodeGenMonad.CodeGen e s ()+x86_cmov_membase ::+  forall e s.+  Int+  -> Bool+  -> Word8+  -> Word8+  -> Word32+  -> Harpy.CodeGenMonad.CodeGen e s ()++
+ Harpy/X86Disassembler.hs view
@@ -0,0 +1,3206 @@+--------------------------------------------------------------------------+-- |+-- Module      :  X86Disassembler+-- Copyright   :  (c) Martin Grabmueller and Dirk Kleeblatt+-- License     :  GPL+-- +-- Maintainer  :  {magr,klee}@cs.tu-berlin.de+-- Stability   :  provisional+-- Portability :  portable+--+-- 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 files+-- 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,+  testFile+  ) 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)++-- 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++-- 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)+++-- | 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+  | 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++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 s = showHex i ""+    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 (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 (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 i =+  "$0x" ++ showHex i ""++showIntelImm i =+  let h = showHex i "H"+      (f:_) = h+  in (if isDigit f then "" else "0") ++ showHex i "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") ++ showHex w "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)} l+  where +  toList :: (Ptr Word8) -> Int -> Int -> IO [Word8]+  toList ptr len idx | idx < len =+       	   do p <- peekByteOff ptr idx+       	      r <- toList ptr len (idx + 1)+       	      return (p : r)+  toList ptr len idx | idx >= len = return []++-- | 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}+    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 of+       	       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
+ Makefile view
@@ -0,0 +1,24 @@+.PHONY: all clean install reinstall uninstall doc++all:+	runhaskell Setup.hs configure --prefix=$(HOME)/+	runhaskell Setup.hs build++clean:+	runhaskell Setup.hs clean+++install:+	runhaskell Setup.hs install --user++reinstall:+	runhaskell Setup.hs clean+	runhaskell Setup.hs configure --prefix=$(HOME)/+	runhaskell Setup.hs build+	runhaskell Setup.hs install --user++uninstall:+	runhaskell Setup.hs unregister --user++doc:+	runhaskell Setup.hs haddock
+ README view
@@ -0,0 +1,65 @@+                                                              -*-outline-*-+* README file for the Harpy Haskell Run-time Code Generator++Codename: Harpy - Haskell Assembler at Run-time produces Y...+  Harpy [myth.]	f: die Harpyie+  http://en.wikipedia.org/wiki/Harpy++** Introduction++Harpy is a library for run-time code generation in Haskell programs.++Harpy requires several Haskell extensions and GHC-specific features+(the Haskell FFI, Template Haskell, multi-parameter type classes and+monad transformers).++** Features++The following modules are included in this package:++Harpy.CodeGenMonad: This module defines the code generator monad,+  which is a combined state/reader/exception monad.  It contains+  all the necessary details for allocating and managing code buffers.++Harpy.X86CodeGen: This module contains all the functions for generating+  native x86 machine code.  The functions are very simple, and it is+  necessary to specify all addressing modes etc. when emitting an+  instruction.++Harpy.X86Assembler: A type class based layer on top of X86CodeGen+  which determines the addressing modes from the types of the+  operands.++Harpy.X86CGCombinators: Code generation combinators for conditionals,+  loops, function entry/exit code etc.++Harpy.X86Disassembler: A disassembler for x86 machine code.++Harpy.Call: Exports functions for invoking the generated code.++** Notes about the implementation++*** X86CodeGen.lhs++The file X86CodeGen.lhs is based on a header file called x86-codegen.h+from the Mono distribution, which defines macros for emitting x86+machine code directly into a memory buffer.  The Haskell module is a+nearly one-to-one mapping from the original macros to Haskell+functions.  The main differences are:++- Instead of emitting the data directly into a buffer, it uses the+  CodeGen monad from file CodeGenMonad.lhs.++- The functions are strongly typed.++Several things should be kept in mind when using this file:++- Buffer overflow checks have to be done manually with checkBufferSize or+  ensureBufferSize++- MMX, SSE, SSE2 and SSE3 instructions and registers are not supported.++- 64-bit mode is not supported.++- The disassembler supports (in principle) 64-bit mode and SSE+  instructions, but this has not been tested.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ doc/tutorial.lhs view
@@ -0,0 +1,199 @@+\documentclass[a4paper]{article}++\usepackage[latin1]{inputenc}++\usepackage{listings}++\lstnewenvironment{code}{}{}+\lstset{+  basicstyle=\ttfamily,+  keywordstyle=\normalfont\bfseries,+  identifierstyle=\bfseries,+  commentstyle=\rmfamily,+  texcl=true, +  language=Haskell,+  flexiblecolumns=false,+  basewidth={0.5em,0.45em},+  extendedchars=true, +  frame=leftline,+  numbers=left,+  firstnumber=last,+  literate={+}{{$+$}}1 {/}{{$/$}}1 {*}{{$*$}}1 {=}{{$=$}}1+           {>}{{$>$}}1 {<}{{$<$}}1 +           {->}{{$\rightarrow$}}2 {>=}{{$\geq$}}2 {<-}{{$\leftarrow$}}2+           {<=}{{$\leq$}}2 {=>}{{$\Rightarrow$}}2 {\ .}{{ $\circ$}}2,+  numberstyle=\tiny+} ++\title{Harpy Tutorial}+\author{Martin Grabmüller \and Dirk Kleeblatt}++\begin{document}+\maketitle+\abstract{+We present some of the features of+Harpy, an in-line assembler for Haskell.  This little tutorial shows how to+write assembler programs without making one's hands dirty, staying in the+beautiful pure functional world of Haskell.  During this tutorial, we develop+step by step an assembler implementation of the factorial function, and show+how assembler code can be called from ordinary Haskell code.++This document is written as a litarate Haskell program, so you can compile and run it+without any modifications.+}++\section{Introduction}++To make use of Harpy and (a subset of) the x86 assembler instructions, we need+to import some modules.++\begin{code}+import Harpy.CodeGenMonad+import Harpy.X86Assembler+import Foreign+import Control.Monad.Trans+\end{code}++The module \lstinline-Harpy.CodeGenMonad- defines the polymorphic type+\lstinline-CodeGen e s-, which is an instance of the \lstinline-Monad-+class. The type parameters \lstinline-e- and \lstinline-s- can be instantiated+to the type of an user's environment and state, respectively. These behave+like the environments and states known from the \lstinline-Reader- and+\lstinline-State- monads. Besides this monadic type, this module defines some+functions to make use of code labels, and provides an interface to a+disassembler.++The module \lstinline-Harpy.X86Assembler- provides a subset of the x86+assembler instructions, e.~g. \verb-mov- for moving memory words around. These+instructions are implemented as class methods, to allow different addressing+modes without hassle.++We additionally import the module \lstinline-Foreign-, since we need some low+level types to exchange parameters and results with our assembler code, and+\lstinline-Control.Monad.MonadTrans- to have some instances available.++\section{A fast factorial function}++Now we are ready to define the factorial function in assembler code.++\lstset{firstnumber=4}+\begin{code}+fac :: CodeGen e s ()+fac = do loopTest  <- newLabel+         loopStart <- newLabel+         ensureBufferSize 160+         push ecx+         mov  ecx (Disp 8, esp)+         mov  eax (1 :: Word32)+         jmp  loopTest+         loopStart @@ mul ecx+         sub  ecx (1 :: Word32)+         loopTest @@ cmp ecx (0 :: Word32)+         jne  loopStart+         pop  ecx+         ret+\end{code}++We first create two labels, \lstinline-loopTest- and \lstinline-loopStart-, to+mark the test and the beginning of a loop. In lines 5 and 6, these labels are+merely announced to Harpy, they are not (yet) defined to sit at a specific+code position.++Line 8 saves the \lstinline-ecx- rigister on the system stack, because we will+use it as a loop counter, and want to restore it before returning to Haskell+functions.++Line 9 shows an indirect adressing with displacement. Note, that all Harpy+functions use Intel assembler style, i.~e. the first operand is the+destination and the second one the source of each instruction. So this line+moves the memory contents at address \lstinline-esp+8- into+\lstinline-ecx-. Since we will make a C call into our assembler code, this+accesses the first parameter on the stack. When returning to the Haskell world+via \lstinline-ret-, we leave our result in \lstinline-eax-, again adhering to+the C calling convention.++The rest of \lstinline-fac- just accumulates the factorial in \lstinline-eax-+while counting down \lstinline-ecx-. Lines 12 and 14 show how our labels+\lstinline-loopStart- and \lstinline-loopTest- are placed at specific code+positions.++The function \lstinline-fac- is not really our wanted factorial+function. Instead it is a monadic command that, when executed, writes+assembler code into a buffer. To ensure, that this buffer is always large+enough to hold the generated instruction, you have to sprinkle your code with+calls to \lstinline-ensureBufferSize-. In line 7 we make sure that 160 bytes+are available, which is enough for our 10 instructions. As a rule of thumb, no+instruction can be larger than 16 bytes, so the number of assembler+instructions times 16 is a safe upper bound.++The next section shows how to prepare a call into such a buffer.++\section{Preparing a call}++The module \lstinline-Harpy.Call- defines some functions to call functions+written in assembler with various argument and result types. But since it is+possible to use all types suitable for FFI calls as argument or result, sooner+or later you will need some combination not yet implemented. So here we show+how to define your own calling stub.++\lstset{firstnumber=18}+\begin{code}+$(callDecl "callFac" [t|Word32 -> Word32|])+\end{code}++The Template Haskell function \lstinline-callDecl- is used to declare a+function \lstinline-callFac- which will call our assembler fragment. We want+to pass a parameter of type \lstinline-Word32-, and expect a result of the+same type, that's why we give \lstinline+Word32 -> Word32+ as argument to+\lstinline-callDecl-. If you wonder about the fancy \lstinline-$- and+\lstinline-[t| |]-, either look them up in the Template Haskell+documentation, or just ignore them. However, to make this line compile, you+have to switch on Template Haskell, which is done for the Glasgow Haskell+compiler by the command line flag \verb+-fth+.++\section{Calling \lstinline-fac-}++Now we have all we need to call into our factorial function.++\lstset{firstnumber=19}+\begin{code}+runFac :: CodeGen e s ()+runFac = do fac+            x <- liftIO readLn+            y <- callFac x+            liftIO (putStrLn (show y))+\end{code}++We first call \lstinline-fac- to write our assembler code into the internal+buffer. Since the \lstinline-CodeGen- monad ist an instance of+\lstinline-MonadIO-, we can use \lstinline-liftIO- to use all commands we wish+from the \lstinline-IO- monad. Here, we use this to read the argument to the+factorial function from the keyboard, and to write the result back to the+screen. Line 21 calls into the internal code buffer with our assembler+instructions using the stub declared in the last section.++\section{How to use it}++Up to now, all our functions live in the \lstinline-CodeGen- monad. To make+use of them, we have to \emph{unlift} them into the \lstinline-IO- monad. This+is done by \lstinline-runCodeGen-.++\lstset{firstnumber=24}+\begin{code}+main :: IO ()+main = do+   (finalState, result) <- runCodeGen runFac () ()+   case result of+     Right () -> return ()+     Left err -> putStrLn (show err)+\end{code}++The second and third arguments to \lstinline-runCodeGen- are the initial+environment and state. Since we did not use them, their type is polymorphic+and we can use \lstinline-()- as initial values. The result is a pair+consisting of the final state, and a result value. A value constructed with+the constructor \lstinline-Right- indicates a successful run, while+\lstinline-Left- values indicate runtime errors. These might occur for+instance because of infeasible addressing modes.++ \end{document}
+ harpy.cabal view
@@ -0,0 +1,41 @@+Name:           harpy+Version:        0.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+Homepage:       http://uebb.cs.tu-berlin.de/harpy/+Category:       Code generation+Synopsis:       Runtime code generation for x86 machine code+Description:	The package contains the following components:+	.+	* An x86 assembler.  We provide both low-level code generation in+	  module "Harpy.X86CodeGen" as well as a (slightly) higher-level+	  implementation in module "Harpy.X86Assembler", which figures out+	  addressing modes based on an instruction's operand types.+	.+	* 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".+	.+	* Some abstractions over the abovementioned code generation modules,+	  such as automatic label management and code generation+	  combinators (for if-then-else statements, while-loops, functions)+	  (module "Harpy.X86CGCombinators").+	.+	* All the above modules use the code generation monad defined in module+	  "Harpy.CodeGenMonad".+Stability:      Experimental+Build-depends:  base, parsec, mtl, template-haskell+Exposed-Modules:+    Harpy.X86CodeGen,+    Harpy.X86Assembler,+    Harpy.CodeGenMonad,+    Harpy.Call,+    Harpy.X86Disassembler,+    Harpy.X86CGCombinators+Extensions:     ForeignFunctionInterface, MultiParamTypeClasses, +	TemplateHaskell, CPP+ghc-options:	-O