x86-64bit 0.4.4 → 0.4.5

raw patch · 7 files changed

+70/−30 lines, 7 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• CHANGELOG.md +4/−0
• CodeGen/X86.hs +15/−7
• CodeGen/X86/Asm.hs +16/−9
• CodeGen/X86/CodeGen.hs +20/−10
• CodeGen/X86/Tests.hs +3/−3
• TODO.md +11/−0
• x86-64bit.cabal +1/−1

@@ -1,3 +1,7 @@+# Version 0.4.5
+
+-   fix build with newer base
+
 # Version 0.4.4
 
 -   export some useful data types 

@@ -8,8 +8,10 @@     , Size (..)     , HasSize (..)     , IsSize+    , EqT (..)+    , sizeEqCheck     -- * Registers-    , Reg , FromReg (..)+    , Reg (..) , FromReg (..)     -- ** 64 bit registers     , rax, rcx, rdx, rbx, rsp, rbp, rsi, rdi, r8, r9, r10, r11, r12, r13, r14, r15     -- ** 32 bit registers@@ -62,13 +64,14 @@     , align     , Label     , label-    -- ** Control+    -- ** Control instructions     , j     , jmp     , jmpq     , call     , ret-    -- ** Flags+    , nop+    -- ** Flag manipulation     , cmc     , clc     , stc@@ -78,17 +81,23 @@     , std     , pushf     , popf+    -- *** Conditionals     , cmp     , test+    , bt+    , bsf+    , bsr     -- ** Arithmetic     , inc     , dec-    , not_     , neg     , add     , adc     , sub     , sbb+    , lea+    -- ** Bit manipulation+    , not_     , and_     , or_     , xor_@@ -99,9 +108,8 @@     , shl     , shr     , sar-    , lea-    -- ** Other-    , nop+    -- ** Byte manipulation/move+    , bswap     , xchg     , mov     , cmov

@@ -63,11 +63,12 @@ ------------------------------------------------------- sizes  -- | The size of a register (in bits)-data Size = S8 | S16 | S32 | S64 | S128+data Size = S1 | S8 | S16 | S32 | S64 | S128     deriving (Eq, Ord)  instance Show Size where     show = \case+        S1   -> "bit"         S8   -> "byte"         S16  -> "word"         S32  -> "dword"@@ -100,6 +101,7 @@  -- | Singleton type for size data SSize (s :: Size) where+    SSize1   :: SSize S1     SSize8   :: SSize S8     SSize16  :: SSize S16     SSize32  :: SSize S32@@ -108,6 +110,7 @@  instance HasSize (SSize s) where     size = \case+        SSize1   -> S1         SSize8   -> S8         SSize16  -> S16         SSize32  -> S32@@ -117,6 +120,7 @@ class IsSize (s :: Size) where     ssize :: SSize s +instance IsSize S1   where ssize = SSize1 instance IsSize S8   where ssize = SSize8 instance IsSize S16  where ssize = SSize16 instance IsSize S32  where ssize = SSize32@@ -220,15 +224,13 @@     deriving (Eq)  type BaseReg s    = Maybe (Reg s)-type IndexReg s   = Maybe (Scale, Reg s)+data IndexReg s   = NoIndex | IndexReg Scale (Reg s)+    deriving (Eq) type Displacement = Maybe Int32  pattern NoDisp = Nothing pattern Disp a = Just a -pattern NoIndex = Nothing-pattern IndexReg a b = Just (a, b)- -- | intruction pointer (RIP) relative address ipRel :: Label -> Operand rw s ipRel l = IPMemOp $ LabelRelValue S32 l@@ -315,8 +317,8 @@     signum = error "signum @Operand"  instance Monoid (Addr s) where-    mempty = Addr (getFirst mempty) (getFirst mempty) (getFirst mempty)-    Addr a b c `mappend` Addr a' b' c' = Addr (getFirst $ First a <> First a') (getFirst $ First b <> First b') (getFirst $ First c <> First c')+    mempty = Addr (getFirst mempty) (getFirst mempty) mempty+    Addr a b c `mappend` Addr a' b' c' = Addr (getFirst $ First a <> First a') (getFirst $ First b <> First b') (c <> c')  instance Monoid (IndexReg s) where     mempty = NoIndex@@ -553,9 +555,10 @@ data CodeLine where     Ret_, Nop_, PushF_, PopF_, Cmc_, Clc_, Stc_, Cli_, Sti_, Cld_, Std_   :: CodeLine -    Inc_, Dec_, Not_, Neg_                                :: IsSize s => Operand RW s -> CodeLine-    Add_, Or_, Adc_, Sbb_, And_, Sub_, Xor_, Cmp_, Test_, Mov_  :: IsSize s => Operand RW s -> Operand r s -> CodeLine+    Inc_, Dec_, Not_, Neg_, Bswap                               :: IsSize s => Operand RW s -> CodeLine+    Add_, Or_, Adc_, Sbb_, And_, Sub_, Xor_, Cmp_, Test_, Mov_, Bsf, Bsr :: IsSize s => Operand RW s -> Operand r s -> CodeLine     Rol_, Ror_, Rcl_, Rcr_, Shl_, Shr_, Sar_                 :: IsSize s => Operand RW s -> Operand r S8 -> CodeLine+    Bt :: IsSize s => Operand r s -> Operand RW s -> CodeLine      Movdqa_, Paddb_, Paddw_, Paddd_, Paddq_, Psubb_, Psubw_, Psubd_, Psubq_, Pxor_ :: Operand RW S128 -> Operand r S128 -> CodeLine     Psllw_, Pslld_, Psllq_, Pslldq_, Psrlw_, Psrld_, Psrlq_, Psrldq_, Psraw_, Psrad_ :: Operand RW S128 -> Operand r S8 -> CodeLine@@ -604,6 +607,9 @@     Xor_  op1 op2 -> showOp2 "xor"  op1 op2     Cmp_  op1 op2 -> showOp2 "cmp"  op1 op2     Test_ op1 op2 -> showOp2 "test" op1 op2+    Bsf   op1 op2 -> showOp2 "bsf"  op1 op2+    Bsr   op1 op2 -> showOp2 "bsr"  op1 op2+    Bt    op1 op2 -> showOp2 "bt"   op1 op2     Rol_  op1 op2 -> showOp2 "rol"  op1 op2     Ror_  op1 op2 -> showOp2 "ror"  op1 op2     Rcl_  op1 op2 -> showOp2 "rcl"  op1 op2@@ -641,6 +647,7 @@     Dec_  op -> showOp1 "dec"  op     Not_  op -> showOp1 "not"  op     Neg_  op -> showOp1 "neg"  op+    Bswap op -> showOp1 "bswap" op     Pop_  op -> showOp1 "pop"  op     Push_ op -> showOp1 "push" op     Call_ op -> showOp1 "call" op

@@ -71,7 +71,7 @@  regs :: IsSize s => Operand r s -> [SReg] regs = \case-    MemOp (Addr r _ i) -> foldMap (pure . SReg) r ++ foldMap (pure . SReg . snd) i+    MemOp (Addr r _ i) -> foldMap (pure . SReg) r ++ case i of NoIndex -> []; IndexReg _ x -> [SReg x]     RegOp r -> [SReg r]     _ -> mempty @@ -280,13 +280,16 @@       where         (dest', src') = if isMemOp src then (src, dest) else (dest, src) -    Mov_ dest@(RegOp r) ((if size dest == S64 then mkImm S32 <> mkImmS S32 <> mkImmS S64 else mkImmS (size dest)) -> FJust ((se, si), im))+    Mov_ dest@(RegOp r) ((if size dest == S64 then mkImmU S32 <> mkImm S64 else mkImm (size dest)) -> FJust ((se, si), im))         | (se, si, size dest) /= (True, S32, S64) -> regprefix si dest (oneReg (0x16 .|. indicator (size dest /= S8)) r) im         | otherwise -> regprefix'' dest 0x63 (reg8 0x0 dest) im     Mov_ dest@(size -> s) (mkImmNo64 s -> FJust (_, im)) -> regprefix'' dest 0x63 (reg8 0x0 dest) im     Mov_ dest src -> op2' 0x44 dest $ noImm (show (dest, src)) src      Cmov_ (Condition c) dest src | size dest /= S8 -> regprefix2 src dest $ codeByte 0x0f <> codeByte (0x40 .|. c) <> reg2x8 dest src+    Bsf dest src | size dest /= S8 -> regprefix2 src dest $ codeByte 0x0f <> codeByte 0xbc <> reg2x8 dest src+    Bsr dest src | size dest /= S8 -> regprefix2 src dest $ codeByte 0x0f <> codeByte 0xbd <> reg2x8 dest src+    Bt  src dest | size dest /= S8 -> regprefix2 src dest $ codeByte 0x0f <> codeByte 0xa3 <> reg2x8 dest src      Lea_ dest src | size dest /= S8 -> regprefix2' (resizeOperand' dest src) dest 0x46 $ reg2x8 dest src       where@@ -297,6 +300,8 @@     Neg_  a -> op1 0x7b 0x3 a     Inc_  a -> op1 0x7f 0x0 a     Dec_  a -> op1 0x7f 0x1 a+    Bswap a@RegOp{} | size a >= S32 -> op1 0x07 0x1 a+    Bswap a  -> error $ "wrong bswap operand: " ++ show a      Call_ (ImmOp (LabelRelValue S32 l)) -> codeByte 0xe8 <> mkRef S32 4 l     Call_ a -> op1' 0xff 0x2 a@@ -329,8 +334,8 @@     Pop_ dest@(RegOp r) -> regprefix S32 dest (oneReg 0x0b r) mempty     Pop_ dest -> regprefix S32 dest (codeByte 0x8f <> reg8 0x0 dest) mempty -    Push_ (mkImmS S8 -> FJust (_, im))  -> codeByte 0x6a <> im-    Push_ (mkImmS S32 -> FJust (_, im)) -> codeByte 0x68 <> im+    Push_ (mkImmS S8 -> FJust (_, im)) -> codeByte 0x6a <> im+    Push_ (mkImm S32 -> FJust (_, im)) -> codeByte 0x68 <> im     Push_ dest@(RegOp r) -> regprefix S32 dest (oneReg 0x0a r) mempty     Push_ dest -> regprefix S32 dest (codeByte 0xff <> reg8 0x6 dest) mempty @@ -392,10 +397,11 @@     convertImm True b (ImmOp (LabelRelValue s d)) | b == s = FJust $ (,) (True, b) $ mkRef s (sizeLen s) d     convertImm _ _ _ = FNothing -    mkImmS, mkImm, mkImmNo64 :: Size -> Operand r s -> First ((Bool, Size), CodeBuilder)+    mkImmS, mkImmU, mkImm, mkImmNo64 :: Size -> Operand r s -> First ((Bool, Size), CodeBuilder)     mkImmS = convertImm True-    mkImm  = convertImm False-    mkImmNo64 s = mkImmS (no64 s)+    mkImmU = convertImm False+    mkImm s = mkImmS s <> mkImmU s+    mkImmNo64 s = mkImm (no64 s)      xchg_a :: IsSize s => Operand r s -> CodeBuilder     xchg_a dest@(RegOp r) | size dest /= S8 = regprefix (size dest) dest (oneReg 0x12 r) mempty@@ -466,7 +472,7 @@     sse op a@OpXMM b = regprefix S128 b (codeByte 0x0f <> codeByte op <> reg2x8 a b) mempty      sseShift :: Word8 -> Word8 -> Word8 -> Operand RW S128 -> Operand r S8 -> CodeBuilder-    sseShift op x op' a@OpXMM b@(mkImm S8 -> FJust (_, i)) = regprefix S128 b (codeByte 0x0f <> codeByte op <> reg8 x a) i+    sseShift op x op' a@OpXMM b@(mkImmU S8 -> FJust (_, i)) = regprefix S128 b (codeByte 0x0f <> codeByte op <> reg8 x a) i     -- TODO: xmm argument      extension :: HasSize a => a -> Word8 -> CodeBuilder@@ -474,7 +480,7 @@      extbits :: Operand r s -> Word8     extbits = \case-        MemOp (Addr b _ i) -> maybe 0 indexReg b .|. maybe 0 ((`shiftL` 1) . indexReg . snd) i+        MemOp (Addr b _ i) -> maybe 0 indexReg b .|. case i of NoIndex -> 0; IndexReg _ x -> indexReg x `shiftL` 1         RegOp r -> indexReg r         _ -> 0       where@@ -533,7 +539,7 @@      shiftOp :: IsSize s => Word8 -> Operand RW s -> Operand r S8 -> CodeBuilder     shiftOp c dest (ImmOp (Immediate 1)) = op1 0x68 c dest-    shiftOp c dest (mkImm S8 -> FJust (_, i)) = op1_ 0x60 c dest i+    shiftOp c dest (mkImmU S8 -> FJust (_, i)) = op1_ 0x60 c dest i     shiftOp c dest RegCl = op1 0x69 c dest     shiftOp _ _ _ = error "invalid shift operands" @@ -569,6 +575,10 @@ dec a   = mkCodeLine (Dec_ a) not_ a  = mkCodeLine (Not_ a) neg a   = mkCodeLine (Neg_ a)+bswap a = mkCodeLine (Bswap a)+bsf a b = mkCodeLine (Bsf a b)+bsr a b = mkCodeLine (Bsr a b)+bt a b  = mkCodeLine (Bt  a b) add a b = mkCodeLine (Add_ a b) or_  a b = mkCodeLine (Or_  a b) adc a b = mkCodeLine (Adc_ a b)

@@ -110,8 +110,8 @@ instance Arbitrary (Addr S64) where
     arbitrary = suchThat (Addr <$> base <*> disp <*> index) ok
       where
-        ok (Addr Nothing _ Nothing) = False
-        ok (Addr Nothing _ (Just (sc, _))) = sc == s1
+        ok (Addr Nothing _ NoIndex) = False
+        ok (Addr Nothing _ (IndexReg sc _)) = sc == s1
         ok _ = True
         base = oneof
             [ return Nothing
@@ -393,7 +393,7 @@                     Disp v -> fromIntegral v
                 rx = resizeOperand $ RegOp x :: Operand RW S64
             return (v, ((leaData rx v >> mov helper (fromIntegral d') >> sub rx helper >> setvi) >>))
-        mkVal helper o@(MemOp (Addr Nothing d (Just (sc, x)))) = do
+        mkVal helper o@(MemOp (Addr Nothing d (IndexReg sc x))) = do
             v <- arbVal $ size o
             let
                 d' = case d of

@@ -1,4 +1,15 @@ +# Instructions DSL++The main problem is typing the instructions in Haskell.++Unsolved problems:++-   How to support instructions with variable arguments (like imul)?+-   How to support instructions with mixed sized arguments (like bt)?+-   How to prevent more misuse statically?++ # Support more instructions  -   pusha / popa ?

@@ -1,5 +1,5 @@ name:                x86-64bit
-version:             0.4.4
+version:             0.4.5
 homepage:            https://github.com/divipp/x86-64
 synopsis:            Runtime code generation for x86 64 bit machine code
 description:         The primary goal of x86-64bit is to provide a lightweight assembler for machine generated 64 bit x86 assembly instructions. See README.md for further details.