diff --git a/COPYING b/COPYING new file mode 100644 --- /dev/null +++ b/COPYING @@ -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. + + + Copyright (C) + + 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. + + , 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. diff --git a/Harpy/Call.hs b/Harpy/Call.hs new file mode 100644 --- /dev/null +++ b/Harpy/Call.hs @@ -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 diff --git a/Harpy/CodeGenMonad.hs b/Harpy/CodeGenMonad.hs new file mode 100644 --- /dev/null +++ b/Harpy/CodeGenMonad.hs @@ -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 diff --git a/Harpy/X86Assembler.lhs b/Harpy/X86Assembler.lhs new file mode 100644 --- /dev/null +++ b/Harpy/X86Assembler.lhs @@ -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 diff --git a/Harpy/X86CGCombinators.hs b/Harpy/X86CGCombinators.hs new file mode 100644 --- /dev/null +++ b/Harpy/X86CGCombinators.hs @@ -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}) diff --git a/Harpy/X86CodeGen.hs b/Harpy/X86CodeGen.hs new file mode 100644 --- /dev/null +++ b/Harpy/X86CodeGen.hs @@ -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 () + + diff --git a/Harpy/X86Disassembler.hs b/Harpy/X86Disassembler.hs new file mode 100644 --- /dev/null +++ b/Harpy/X86Disassembler.hs @@ -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", "", ""] +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 diff --git a/Makefile b/Makefile new file mode 100644 --- /dev/null +++ b/Makefile @@ -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 diff --git a/README b/README new file mode 100644 --- /dev/null +++ b/README @@ -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. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/doc/tutorial.lhs b/doc/tutorial.lhs new file mode 100644 --- /dev/null +++ b/doc/tutorial.lhs @@ -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} diff --git a/harpy.cabal b/harpy.cabal new file mode 100644 --- /dev/null +++ b/harpy.cabal @@ -0,0 +1,41 @@ +Name: harpy +Version: 0.2 +License: GPL +License-file: COPYING +Author: Dirk Kleeblatt + Martin Grabmueller +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