{-# LANGUAGE OverloadedStrings #-}

-- | Started out trying to implement maximal munch but ended with something
-- "flatter" that works with Kempe IR and my shitty register allocator.
module Kempe.Asm.X86 ( irToX86
                     ) where

import           Control.Monad.State.Strict (State, evalState, gets, modify)
import           Data.Foldable.Ext
import           Data.List                  (scanl')
import           Data.Word                  (Word8)
import           Kempe.AST
import           Kempe.Asm.X86.Type
import qualified Kempe.IR                   as IR

toAbsReg :: IR.Temp -> AbsReg
toAbsReg :: Temp -> AbsReg
toAbsReg (IR.Temp8 Int
i)   = Int -> AbsReg
AllocReg8 Int
i
toAbsReg (IR.Temp64 Int
i)  = Int -> AbsReg
AllocReg64 Int
i
toAbsReg Temp
IR.DataPointer = AbsReg
DataPointer

type WriteM = State IR.WriteSt

irToX86 :: SizeEnv -> IR.WriteSt -> [IR.Stmt] -> [X86 AbsReg ()]
irToX86 :: SizeEnv -> WriteSt -> [Stmt] -> [X86 AbsReg ()]
irToX86 SizeEnv
env WriteSt
w = WriteSt -> WriteM [X86 AbsReg ()] -> [X86 AbsReg ()]
forall a. WriteSt -> WriteM a -> a
runWriteM WriteSt
w (WriteM [X86 AbsReg ()] -> [X86 AbsReg ()])
-> ([Stmt] -> WriteM [X86 AbsReg ()]) -> [Stmt] -> [X86 AbsReg ()]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Stmt -> WriteM [X86 AbsReg ()])
-> [Stmt] -> WriteM [X86 AbsReg ()]
forall (f :: * -> *) (t :: * -> *) m a.
(Applicative f, Traversable t, Monoid m) =>
(a -> f m) -> t a -> f m
foldMapA (SizeEnv -> Stmt -> WriteM [X86 AbsReg ()]
irEmit SizeEnv
env)

nextLabels :: IR.WriteSt -> IR.WriteSt
nextLabels :: WriteSt -> WriteSt
nextLabels (IR.WriteSt [Label]
ls [Int]
ts) = [Label] -> [Int] -> WriteSt
IR.WriteSt ([Label] -> [Label]
forall a. [a] -> [a]
tail [Label]
ls) [Int]
ts

nextInt :: IR.WriteSt -> IR.WriteSt
nextInt :: WriteSt -> WriteSt
nextInt (IR.WriteSt [Label]
ls [Int]
ts) = [Label] -> [Int] -> WriteSt
IR.WriteSt [Label]
ls ([Int] -> [Int]
forall a. [a] -> [a]
tail [Int]
ts)

getInt :: WriteM Int
getInt :: WriteM Int
getInt = (WriteSt -> Int) -> WriteM Int
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets ([Int] -> Int
forall a. [a] -> a
head ([Int] -> Int) -> (WriteSt -> [Int]) -> WriteSt -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WriteSt -> [Int]
IR.temps) WriteM Int -> StateT WriteSt Identity () -> WriteM Int
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* (WriteSt -> WriteSt) -> StateT WriteSt Identity ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify WriteSt -> WriteSt
nextInt

getLabel :: WriteM IR.Label
getLabel :: WriteM Label
getLabel = (WriteSt -> Label) -> WriteM Label
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets ([Label] -> Label
forall a. [a] -> a
head ([Label] -> Label) -> (WriteSt -> [Label]) -> WriteSt -> Label
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WriteSt -> [Label]
IR.wlabels) WriteM Label -> StateT WriteSt Identity () -> WriteM Label
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* (WriteSt -> WriteSt) -> StateT WriteSt Identity ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify WriteSt -> WriteSt
nextLabels

allocTemp64 :: WriteM IR.Temp
allocTemp64 :: WriteM Temp
allocTemp64 = Int -> Temp
IR.Temp64 (Int -> Temp) -> WriteM Int -> WriteM Temp
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WriteM Int
getInt

allocTemp8 :: WriteM IR.Temp
allocTemp8 :: WriteM Temp
allocTemp8 = Int -> Temp
IR.Temp8 (Int -> Temp) -> WriteM Int -> WriteM Temp
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WriteM Int
getInt

allocReg64 :: WriteM AbsReg
allocReg64 :: WriteM AbsReg
allocReg64 = Int -> AbsReg
AllocReg64 (Int -> AbsReg) -> WriteM Int -> WriteM AbsReg
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WriteM Int
getInt

allocReg8 :: WriteM AbsReg
allocReg8 :: WriteM AbsReg
allocReg8 = Int -> AbsReg
AllocReg8 (Int -> AbsReg) -> WriteM Int -> WriteM AbsReg
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WriteM Int
getInt

runWriteM :: IR.WriteSt -> WriteM a -> a
runWriteM :: WriteSt -> WriteM a -> a
runWriteM = (WriteM a -> WriteSt -> a) -> WriteSt -> WriteM a -> a
forall a b c. (a -> b -> c) -> b -> a -> c
flip WriteM a -> WriteSt -> a
forall s a. State s a -> s -> a
evalState

-- | This should handle 'MovMem's of divers sizes but for now it just does
-- 1 byte or 8 bytes at a time.
irEmit :: SizeEnv -> IR.Stmt -> WriteM [X86 AbsReg ()]
irEmit :: SizeEnv -> Stmt -> WriteM [X86 AbsReg ()]
irEmit SizeEnv
_ (IR.Jump Label
l) = [X86 AbsReg ()] -> WriteM [X86 AbsReg ()]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [() -> Label -> X86 AbsReg ()
forall reg a. a -> Label -> X86 reg a
Jump () Label
l]
irEmit SizeEnv
_ (IR.Labeled Label
l) = [X86 AbsReg ()] -> WriteM [X86 AbsReg ()]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [() -> Label -> X86 AbsReg ()
forall reg a. a -> Label -> X86 reg a
Label () Label
l]
irEmit SizeEnv
_ (IR.KCall Label
l) = [X86 AbsReg ()] -> WriteM [X86 AbsReg ()]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [() -> Label -> X86 AbsReg ()
forall reg a. a -> Label -> X86 reg a
Call () Label
l]
irEmit SizeEnv
_ Stmt
IR.Ret = [X86 AbsReg ()] -> WriteM [X86 AbsReg ()]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [() -> X86 AbsReg ()
forall reg a. a -> X86 reg a
Ret ()]
irEmit SizeEnv
_ (IR.MovMem (IR.Reg Temp
r) Int64
_ (IR.ExprIntBinOp IntBinOp
IR.IntMinusIR (IR.Reg Temp
r1) (IR.Reg Temp
r2))) = do
    { AbsReg
r' <- WriteM AbsReg
allocReg64
    ; [X86 AbsReg ()] -> WriteM [X86 AbsReg ()]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [ () -> AbsReg -> AbsReg -> X86 AbsReg ()
forall reg a. a -> reg -> reg -> X86 reg a
MovRR () AbsReg
r' (Temp -> AbsReg
toAbsReg Temp
r1), () -> AbsReg -> AbsReg -> X86 AbsReg ()
forall reg a. a -> reg -> reg -> X86 reg a
SubRR () AbsReg
r' (Temp -> AbsReg
toAbsReg Temp
r2), () -> Addr AbsReg -> AbsReg -> X86 AbsReg ()
forall reg a. a -> Addr reg -> reg -> X86 reg a
MovAR () (AbsReg -> Addr AbsReg
forall reg. reg -> Addr reg
Reg (AbsReg -> Addr AbsReg) -> AbsReg -> Addr AbsReg
forall a b. (a -> b) -> a -> b
$ Temp -> AbsReg
toAbsReg Temp
r) AbsReg
r' ]
    }
irEmit SizeEnv
_ (IR.MovMem (IR.Reg Temp
r) Int64
_ (IR.ConstInt Int64
i)) =
    [X86 AbsReg ()] -> WriteM [X86 AbsReg ()]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [ () -> Addr AbsReg -> Int64 -> X86 AbsReg ()
forall reg a. a -> Addr reg -> Int64 -> X86 reg a
MovAC () (AbsReg -> Addr AbsReg
forall reg. reg -> Addr reg
Reg (AbsReg -> Addr AbsReg) -> AbsReg -> Addr AbsReg
forall a b. (a -> b) -> a -> b
$ Temp -> AbsReg
toAbsReg Temp
r) Int64
i ]
irEmit SizeEnv
_ (IR.MovMem (IR.Reg Temp
r) Int64
_ (IR.ConstBool Bool
b)) =
    [X86 AbsReg ()] -> WriteM [X86 AbsReg ()]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [ () -> Addr AbsReg -> Word8 -> X86 AbsReg ()
forall reg a. a -> Addr reg -> Word8 -> X86 reg a
MovABool () (AbsReg -> Addr AbsReg
forall reg. reg -> Addr reg
Reg (AbsReg -> Addr AbsReg) -> AbsReg -> Addr AbsReg
forall a b. (a -> b) -> a -> b
$ Temp -> AbsReg
toAbsReg Temp
r) (Bool -> Word8
toByte Bool
b) ]
irEmit SizeEnv
_ (IR.MovMem (IR.Reg Temp
r) Int64
_ (IR.ConstTag Word8
b)) =
    [X86 AbsReg ()] -> WriteM [X86 AbsReg ()]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [ () -> Addr AbsReg -> Word8 -> X86 AbsReg ()
forall reg a. a -> Addr reg -> Word8 -> X86 reg a
MovACTag () (AbsReg -> Addr AbsReg
forall reg. reg -> Addr reg
Reg (AbsReg -> Addr AbsReg) -> AbsReg -> Addr AbsReg
forall a b. (a -> b) -> a -> b
$ Temp -> AbsReg
toAbsReg Temp
r) Word8
b ]
irEmit SizeEnv
_ (IR.MovMem (IR.Reg Temp
r) Int64
_ (IR.ExprIntBinOp IntBinOp
IR.IntTimesIR (IR.Reg Temp
r1) (IR.Reg Temp
r2))) = do
    { AbsReg
r' <- WriteM AbsReg
allocReg64
    ; [X86 AbsReg ()] -> WriteM [X86 AbsReg ()]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [ () -> AbsReg -> AbsReg -> X86 AbsReg ()
forall reg a. a -> reg -> reg -> X86 reg a
MovRR () AbsReg
r' (Temp -> AbsReg
toAbsReg Temp
r1), () -> AbsReg -> AbsReg -> X86 AbsReg ()
forall reg a. a -> reg -> reg -> X86 reg a
ImulRR () AbsReg
r' (Temp -> AbsReg
toAbsReg Temp
r2), () -> Addr AbsReg -> AbsReg -> X86 AbsReg ()
forall reg a. a -> Addr reg -> reg -> X86 reg a
MovAR () (AbsReg -> Addr AbsReg
forall reg. reg -> Addr reg
Reg (AbsReg -> Addr AbsReg) -> AbsReg -> Addr AbsReg
forall a b. (a -> b) -> a -> b
$ Temp -> AbsReg
toAbsReg Temp
r) AbsReg
r' ]
    }
irEmit SizeEnv
_ (IR.MovMem (IR.ExprIntBinOp IntBinOp
IR.IntPlusIR (IR.Reg Temp
r0) (IR.ConstInt Int64
i)) Int64
_ (IR.Mem Int64
1 (IR.ExprIntBinOp IntBinOp
IR.IntPlusIR (IR.Reg Temp
r1) (IR.ConstInt Int64
j)))) = do
    { AbsReg
r' <- WriteM AbsReg
allocReg8
    ; [X86 AbsReg ()] -> WriteM [X86 AbsReg ()]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [ () -> AbsReg -> Addr AbsReg -> X86 AbsReg ()
forall reg a. a -> reg -> Addr reg -> X86 reg a
MovRA () AbsReg
r' (AbsReg -> Int64 -> Addr AbsReg
forall reg. reg -> Int64 -> Addr reg
AddrRCPlus (Temp -> AbsReg
toAbsReg Temp
r1) Int64
j), () -> Addr AbsReg -> AbsReg -> X86 AbsReg ()
forall reg a. a -> Addr reg -> reg -> X86 reg a
MovAR () (AbsReg -> Int64 -> Addr AbsReg
forall reg. reg -> Int64 -> Addr reg
AddrRCPlus (Temp -> AbsReg
toAbsReg Temp
r0) Int64
i) AbsReg
r' ]
    }
irEmit SizeEnv
_ (IR.MovMem (IR.ExprIntBinOp IntBinOp
IR.IntPlusIR (IR.Reg Temp
r0) (IR.ConstInt Int64
i)) Int64
_ (IR.Mem Int64
1 (IR.ExprIntBinOp IntBinOp
IR.IntMinusIR (IR.Reg Temp
r1) (IR.ConstInt Int64
j)))) = do
    { AbsReg
r' <- WriteM AbsReg
allocReg8
    ; [X86 AbsReg ()] -> WriteM [X86 AbsReg ()]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [ () -> AbsReg -> Addr AbsReg -> X86 AbsReg ()
forall reg a. a -> reg -> Addr reg -> X86 reg a
MovRA () AbsReg
r' (AbsReg -> Int64 -> Addr AbsReg
forall reg. reg -> Int64 -> Addr reg
AddrRCMinus (Temp -> AbsReg
toAbsReg Temp
r1) Int64
j), () -> Addr AbsReg -> AbsReg -> X86 AbsReg ()
forall reg a. a -> Addr reg -> reg -> X86 reg a
MovAR () (AbsReg -> Int64 -> Addr AbsReg
forall reg. reg -> Int64 -> Addr reg
AddrRCPlus (Temp -> AbsReg
toAbsReg Temp
r0) Int64
i) AbsReg
r' ]
    }
irEmit SizeEnv
_ (IR.MovMem (IR.ExprIntBinOp IntBinOp
IR.IntMinusIR (IR.Reg Temp
r0) (IR.ConstInt Int64
i)) Int64
_ (IR.Mem Int64
1 (IR.ExprIntBinOp IntBinOp
IR.IntMinusIR (IR.Reg Temp
r1) (IR.ConstInt Int64
j)))) = do
    { AbsReg
r' <- WriteM AbsReg
allocReg8
    ; [X86 AbsReg ()] -> WriteM [X86 AbsReg ()]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [ () -> AbsReg -> Addr AbsReg -> X86 AbsReg ()
forall reg a. a -> reg -> Addr reg -> X86 reg a
MovRA () AbsReg
r' (AbsReg -> Int64 -> Addr AbsReg
forall reg. reg -> Int64 -> Addr reg
AddrRCMinus (Temp -> AbsReg
toAbsReg Temp
r1) Int64
j), () -> Addr AbsReg -> AbsReg -> X86 AbsReg ()
forall reg a. a -> Addr reg -> reg -> X86 reg a
MovAR () (AbsReg -> Int64 -> Addr AbsReg
forall reg. reg -> Int64 -> Addr reg
AddrRCMinus (Temp -> AbsReg
toAbsReg Temp
r0) Int64
i) AbsReg
r' ]
    }
irEmit SizeEnv
_ (IR.MovMem (IR.ExprIntBinOp IntBinOp
IR.IntMinusIR (IR.Reg Temp
r0) (IR.ConstInt Int64
i)) Int64
_ (IR.Mem Int64
1 (IR.ExprIntBinOp IntBinOp
IR.IntPlusIR (IR.Reg Temp
r1) (IR.ConstInt Int64
j)))) = do
    { AbsReg
r' <- WriteM AbsReg
allocReg8
    ; [X86 AbsReg ()] -> WriteM [X86 AbsReg ()]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [ () -> AbsReg -> Addr AbsReg -> X86 AbsReg ()
forall reg a. a -> reg -> Addr reg -> X86 reg a
MovRA () AbsReg
r' (AbsReg -> Int64 -> Addr AbsReg
forall reg. reg -> Int64 -> Addr reg
AddrRCPlus (Temp -> AbsReg
toAbsReg Temp
r1) Int64
j), () -> Addr AbsReg -> AbsReg -> X86 AbsReg ()
forall reg a. a -> Addr reg -> reg -> X86 reg a
MovAR () (AbsReg -> Int64 -> Addr AbsReg
forall reg. reg -> Int64 -> Addr reg
AddrRCMinus (Temp -> AbsReg
toAbsReg Temp
r0) Int64
i) AbsReg
r' ]
    }
irEmit SizeEnv
_ (IR.MovMem (IR.ExprIntBinOp IntBinOp
IR.IntMinusIR (IR.Reg Temp
r0) (IR.ConstInt Int64
i)) Int64
_ (IR.Mem Int64
8 (IR.ExprIntBinOp IntBinOp
IR.IntMinusIR (IR.Reg Temp
r1) (IR.ConstInt Int64
j)))) = do
    { AbsReg
r' <- WriteM AbsReg
allocReg64
    ; [X86 AbsReg ()] -> WriteM [X86 AbsReg ()]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [ () -> AbsReg -> Addr AbsReg -> X86 AbsReg ()
forall reg a. a -> reg -> Addr reg -> X86 reg a
MovRA () AbsReg
r' (AbsReg -> Int64 -> Addr AbsReg
forall reg. reg -> Int64 -> Addr reg
AddrRCMinus (Temp -> AbsReg
toAbsReg Temp
r1) Int64
j), () -> Addr AbsReg -> AbsReg -> X86 AbsReg ()
forall reg a. a -> Addr reg -> reg -> X86 reg a
MovAR () (AbsReg -> Int64 -> Addr AbsReg
forall reg. reg -> Int64 -> Addr reg
AddrRCMinus (Temp -> AbsReg
toAbsReg Temp
r0) Int64
i) AbsReg
r' ]
    }
irEmit SizeEnv
_ (IR.MovMem (IR.ExprIntBinOp IntBinOp
IR.IntMinusIR (IR.Reg Temp
r0) (IR.ConstInt Int64
i)) Int64
_ (IR.Mem Int64
8 (IR.ExprIntBinOp IntBinOp
IR.IntPlusIR (IR.Reg Temp
r1) (IR.ConstInt Int64
j)))) = do
    { AbsReg
r' <- WriteM AbsReg
allocReg64
    ; [X86 AbsReg ()] -> WriteM [X86 AbsReg ()]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [ () -> AbsReg -> Addr AbsReg -> X86 AbsReg ()
forall reg a. a -> reg -> Addr reg -> X86 reg a
MovRA () AbsReg
r' (AbsReg -> Int64 -> Addr AbsReg
forall reg. reg -> Int64 -> Addr reg
AddrRCPlus (Temp -> AbsReg
toAbsReg Temp
r1) Int64
j), () -> Addr AbsReg -> AbsReg -> X86 AbsReg ()
forall reg a. a -> Addr reg -> reg -> X86 reg a
MovAR () (AbsReg -> Int64 -> Addr AbsReg
forall reg. reg -> Int64 -> Addr reg
AddrRCMinus (Temp -> AbsReg
toAbsReg Temp
r0) Int64
i) AbsReg
r' ]
    }
irEmit SizeEnv
_ (IR.MovMem (IR.ExprIntBinOp IntBinOp
IR.IntPlusIR (IR.Reg Temp
r0) (IR.ConstInt Int64
i)) Int64
_ (IR.Mem Int64
8 (IR.ExprIntBinOp IntBinOp
IR.IntPlusIR (IR.Reg Temp
r1) (IR.ConstInt Int64
j)))) = do
    { AbsReg
r' <- WriteM AbsReg
allocReg64
    ; [X86 AbsReg ()] -> WriteM [X86 AbsReg ()]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [ () -> AbsReg -> Addr AbsReg -> X86 AbsReg ()
forall reg a. a -> reg -> Addr reg -> X86 reg a
MovRA () AbsReg
r' (AbsReg -> Int64 -> Addr AbsReg
forall reg. reg -> Int64 -> Addr reg
AddrRCPlus (Temp -> AbsReg
toAbsReg Temp
r1) Int64
j), () -> Addr AbsReg -> AbsReg -> X86 AbsReg ()
forall reg a. a -> Addr reg -> reg -> X86 reg a
MovAR () (AbsReg -> Int64 -> Addr AbsReg
forall reg. reg -> Int64 -> Addr reg
AddrRCPlus (Temp -> AbsReg
toAbsReg Temp
r0) Int64
i) AbsReg
r' ]
    }
irEmit SizeEnv
_ (IR.MovMem (IR.Reg Temp
r) Int64
_ (IR.ExprIntRel RelBinOp
IR.IntEqIR (IR.Reg Temp
r1) (IR.Reg Temp
r2))) = do -- TODO: int eq more general (Reg r1) could be e1 &c.
    { Label
l0 <- WriteM Label
getLabel
    ; Label
l1 <- WriteM Label
getLabel
    ; Label
l2 <- WriteM Label
getLabel
    ; [X86 AbsReg ()] -> WriteM [X86 AbsReg ()]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [ () -> AbsReg -> AbsReg -> X86 AbsReg ()
forall reg a. a -> reg -> reg -> X86 reg a
CmpRegReg () (Temp -> AbsReg
toAbsReg Temp
r1) (Temp -> AbsReg
toAbsReg Temp
r2), () -> Label -> X86 AbsReg ()
forall reg a. a -> Label -> X86 reg a
Je () Label
l0, () -> Label -> X86 AbsReg ()
forall reg a. a -> Label -> X86 reg a
Jump () Label
l1, () -> Label -> X86 AbsReg ()
forall reg a. a -> Label -> X86 reg a
Label () Label
l0, () -> Addr AbsReg -> Word8 -> X86 AbsReg ()
forall reg a. a -> Addr reg -> Word8 -> X86 reg a
MovABool () (AbsReg -> Addr AbsReg
forall reg. reg -> Addr reg
Reg (AbsReg -> Addr AbsReg) -> AbsReg -> Addr AbsReg
forall a b. (a -> b) -> a -> b
$ Temp -> AbsReg
toAbsReg Temp
r) Word8
1, () -> Label -> X86 AbsReg ()
forall reg a. a -> Label -> X86 reg a
Jump () Label
l2, () -> Label -> X86 AbsReg ()
forall reg a. a -> Label -> X86 reg a
Label () Label
l1, () -> Addr AbsReg -> Word8 -> X86 AbsReg ()
forall reg a. a -> Addr reg -> Word8 -> X86 reg a
MovABool () (AbsReg -> Addr AbsReg
forall reg. reg -> Addr reg
Reg (AbsReg -> Addr AbsReg) -> AbsReg -> Addr AbsReg
forall a b. (a -> b) -> a -> b
$ Temp -> AbsReg
toAbsReg Temp
r) Word8
0, () -> Label -> X86 AbsReg ()
forall reg a. a -> Label -> X86 reg a
Label () Label
l2 ]
    }
irEmit SizeEnv
_ (IR.MovMem (IR.Reg Temp
r) Int64
_ (IR.ExprIntRel RelBinOp
IR.IntLtIR (IR.Reg Temp
r1) (IR.Reg Temp
r2))) = do
    { Label
l0 <- WriteM Label
getLabel
    ; Label
l1 <- WriteM Label
getLabel
    ; Label
l2 <- WriteM Label
getLabel
    ; [X86 AbsReg ()] -> WriteM [X86 AbsReg ()]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [ () -> AbsReg -> AbsReg -> X86 AbsReg ()
forall reg a. a -> reg -> reg -> X86 reg a
CmpRegReg () (Temp -> AbsReg
toAbsReg Temp
r1) (Temp -> AbsReg
toAbsReg Temp
r2), () -> Label -> X86 AbsReg ()
forall reg a. a -> Label -> X86 reg a
Jl () Label
l0, () -> Label -> X86 AbsReg ()
forall reg a. a -> Label -> X86 reg a
Jump () Label
l1, () -> Label -> X86 AbsReg ()
forall reg a. a -> Label -> X86 reg a
Label () Label
l0, () -> Addr AbsReg -> Word8 -> X86 AbsReg ()
forall reg a. a -> Addr reg -> Word8 -> X86 reg a
MovABool () (AbsReg -> Addr AbsReg
forall reg. reg -> Addr reg
Reg (AbsReg -> Addr AbsReg) -> AbsReg -> Addr AbsReg
forall a b. (a -> b) -> a -> b
$ Temp -> AbsReg
toAbsReg Temp
r) Word8
1, () -> Label -> X86 AbsReg ()
forall reg a. a -> Label -> X86 reg a
Jump () Label
l2, () -> Label -> X86 AbsReg ()
forall reg a. a -> Label -> X86 reg a
Label () Label
l1, () -> Addr AbsReg -> Word8 -> X86 AbsReg ()
forall reg a. a -> Addr reg -> Word8 -> X86 reg a
MovABool () (AbsReg -> Addr AbsReg
forall reg. reg -> Addr reg
Reg (AbsReg -> Addr AbsReg) -> AbsReg -> Addr AbsReg
forall a b. (a -> b) -> a -> b
$ Temp -> AbsReg
toAbsReg Temp
r) Word8
0, () -> Label -> X86 AbsReg ()
forall reg a. a -> Label -> X86 reg a
Label () Label
l2 ]
    }
irEmit SizeEnv
_ (IR.MovMem (IR.Reg Temp
r) Int64
_ (IR.ExprIntRel RelBinOp
IR.IntGtIR (IR.Reg Temp
r1) (IR.Reg Temp
r2))) = do
    { Label
l0 <- WriteM Label
getLabel
    ; Label
l1 <- WriteM Label
getLabel
    ; Label
l2 <- WriteM Label
getLabel
    ; [X86 AbsReg ()] -> WriteM [X86 AbsReg ()]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [ () -> AbsReg -> AbsReg -> X86 AbsReg ()
forall reg a. a -> reg -> reg -> X86 reg a
CmpRegReg () (Temp -> AbsReg
toAbsReg Temp
r1) (Temp -> AbsReg
toAbsReg Temp
r2), () -> Label -> X86 AbsReg ()
forall reg a. a -> Label -> X86 reg a
Jg () Label
l0, () -> Label -> X86 AbsReg ()
forall reg a. a -> Label -> X86 reg a
Jump () Label
l1, () -> Label -> X86 AbsReg ()
forall reg a. a -> Label -> X86 reg a
Label () Label
l0, () -> Addr AbsReg -> Word8 -> X86 AbsReg ()
forall reg a. a -> Addr reg -> Word8 -> X86 reg a
MovABool () (AbsReg -> Addr AbsReg
forall reg. reg -> Addr reg
Reg (AbsReg -> Addr AbsReg) -> AbsReg -> Addr AbsReg
forall a b. (a -> b) -> a -> b
$ Temp -> AbsReg
toAbsReg Temp
r) Word8
1, () -> Label -> X86 AbsReg ()
forall reg a. a -> Label -> X86 reg a
Jump () Label
l2, () -> Label -> X86 AbsReg ()
forall reg a. a -> Label -> X86 reg a
Label () Label
l1, () -> Addr AbsReg -> Word8 -> X86 AbsReg ()
forall reg a. a -> Addr reg -> Word8 -> X86 reg a
MovABool () (AbsReg -> Addr AbsReg
forall reg. reg -> Addr reg
Reg (AbsReg -> Addr AbsReg) -> AbsReg -> Addr AbsReg
forall a b. (a -> b) -> a -> b
$ Temp -> AbsReg
toAbsReg Temp
r) Word8
0, () -> Label -> X86 AbsReg ()
forall reg a. a -> Label -> X86 reg a
Label () Label
l2 ]
    }
irEmit SizeEnv
_ (IR.MovMem (IR.Reg Temp
r) Int64
_ (IR.ExprIntRel RelBinOp
IR.IntGeqIR (IR.Reg Temp
r1) (IR.Reg Temp
r2))) = do
    { Label
l0 <- WriteM Label
getLabel
    ; Label
l1 <- WriteM Label
getLabel
    ; Label
l2 <- WriteM Label
getLabel
    ; [X86 AbsReg ()] -> WriteM [X86 AbsReg ()]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [ () -> AbsReg -> AbsReg -> X86 AbsReg ()
forall reg a. a -> reg -> reg -> X86 reg a
CmpRegReg () (Temp -> AbsReg
toAbsReg Temp
r1) (Temp -> AbsReg
toAbsReg Temp
r2), () -> Label -> X86 AbsReg ()
forall reg a. a -> Label -> X86 reg a
Jge () Label
l0, () -> Label -> X86 AbsReg ()
forall reg a. a -> Label -> X86 reg a
Jump () Label
l1, () -> Label -> X86 AbsReg ()
forall reg a. a -> Label -> X86 reg a
Label () Label
l0, () -> Addr AbsReg -> Word8 -> X86 AbsReg ()
forall reg a. a -> Addr reg -> Word8 -> X86 reg a
MovABool () (AbsReg -> Addr AbsReg
forall reg. reg -> Addr reg
Reg (AbsReg -> Addr AbsReg) -> AbsReg -> Addr AbsReg
forall a b. (a -> b) -> a -> b
$ Temp -> AbsReg
toAbsReg Temp
r) Word8
1, () -> Label -> X86 AbsReg ()
forall reg a. a -> Label -> X86 reg a
Jump () Label
l2, () -> Label -> X86 AbsReg ()
forall reg a. a -> Label -> X86 reg a
Label () Label
l1, () -> Addr AbsReg -> Word8 -> X86 AbsReg ()
forall reg a. a -> Addr reg -> Word8 -> X86 reg a
MovABool () (AbsReg -> Addr AbsReg
forall reg. reg -> Addr reg
Reg (AbsReg -> Addr AbsReg) -> AbsReg -> Addr AbsReg
forall a b. (a -> b) -> a -> b
$ Temp -> AbsReg
toAbsReg Temp
r) Word8
0, () -> Label -> X86 AbsReg ()
forall reg a. a -> Label -> X86 reg a
Label () Label
l2 ]
    }
irEmit SizeEnv
_ (IR.MovMem (IR.Reg Temp
r) Int64
_ (IR.ExprIntRel RelBinOp
IR.IntNeqIR (IR.Reg Temp
r1) (IR.Reg Temp
r2))) = do
    { Label
l0 <- WriteM Label
getLabel
    ; Label
l1 <- WriteM Label
getLabel
    ; Label
l2 <- WriteM Label
getLabel
    ; [X86 AbsReg ()] -> WriteM [X86 AbsReg ()]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [ () -> AbsReg -> AbsReg -> X86 AbsReg ()
forall reg a. a -> reg -> reg -> X86 reg a
CmpRegReg () (Temp -> AbsReg
toAbsReg Temp
r1) (Temp -> AbsReg
toAbsReg Temp
r2), () -> Label -> X86 AbsReg ()
forall reg a. a -> Label -> X86 reg a
Jne () Label
l0, () -> Label -> X86 AbsReg ()
forall reg a. a -> Label -> X86 reg a
Jump () Label
l1, () -> Label -> X86 AbsReg ()
forall reg a. a -> Label -> X86 reg a
Label () Label
l0, () -> Addr AbsReg -> Word8 -> X86 AbsReg ()
forall reg a. a -> Addr reg -> Word8 -> X86 reg a
MovABool () (AbsReg -> Addr AbsReg
forall reg. reg -> Addr reg
Reg (AbsReg -> Addr AbsReg) -> AbsReg -> Addr AbsReg
forall a b. (a -> b) -> a -> b
$ Temp -> AbsReg
toAbsReg Temp
r) Word8
1, () -> Label -> X86 AbsReg ()
forall reg a. a -> Label -> X86 reg a
Jump () Label
l2, () -> Label -> X86 AbsReg ()
forall reg a. a -> Label -> X86 reg a
Label () Label
l1, () -> Addr AbsReg -> Word8 -> X86 AbsReg ()
forall reg a. a -> Addr reg -> Word8 -> X86 reg a
MovABool () (AbsReg -> Addr AbsReg
forall reg. reg -> Addr reg
Reg (AbsReg -> Addr AbsReg) -> AbsReg -> Addr AbsReg
forall a b. (a -> b) -> a -> b
$ Temp -> AbsReg
toAbsReg Temp
r) Word8
0, () -> Label -> X86 AbsReg ()
forall reg a. a -> Label -> X86 reg a
Label () Label
l2 ]
    }
irEmit SizeEnv
_ (IR.MovMem (IR.Reg Temp
r) Int64
_ (IR.ExprIntRel RelBinOp
IR.IntLeqIR (IR.Reg Temp
r1) (IR.Reg Temp
r2))) = do
    { Label
l0 <- WriteM Label
getLabel
    ; Label
l1 <- WriteM Label
getLabel
    ; Label
l2 <- WriteM Label
getLabel
    ; [X86 AbsReg ()] -> WriteM [X86 AbsReg ()]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [ () -> AbsReg -> AbsReg -> X86 AbsReg ()
forall reg a. a -> reg -> reg -> X86 reg a
CmpRegReg () (Temp -> AbsReg
toAbsReg Temp
r1) (Temp -> AbsReg
toAbsReg Temp
r2), () -> Label -> X86 AbsReg ()
forall reg a. a -> Label -> X86 reg a
Jle () Label
l0, () -> Label -> X86 AbsReg ()
forall reg a. a -> Label -> X86 reg a
Jump () Label
l1, () -> Label -> X86 AbsReg ()
forall reg a. a -> Label -> X86 reg a
Label () Label
l0, () -> Addr AbsReg -> Word8 -> X86 AbsReg ()
forall reg a. a -> Addr reg -> Word8 -> X86 reg a
MovABool () (AbsReg -> Addr AbsReg
forall reg. reg -> Addr reg
Reg (AbsReg -> Addr AbsReg) -> AbsReg -> Addr AbsReg
forall a b. (a -> b) -> a -> b
$ Temp -> AbsReg
toAbsReg Temp
r) Word8
1, () -> Label -> X86 AbsReg ()
forall reg a. a -> Label -> X86 reg a
Jump () Label
l2, () -> Label -> X86 AbsReg ()
forall reg a. a -> Label -> X86 reg a
Label () Label
l1, () -> Addr AbsReg -> Word8 -> X86 AbsReg ()
forall reg a. a -> Addr reg -> Word8 -> X86 reg a
MovABool () (AbsReg -> Addr AbsReg
forall reg. reg -> Addr reg
Reg (AbsReg -> Addr AbsReg) -> AbsReg -> Addr AbsReg
forall a b. (a -> b) -> a -> b
$ Temp -> AbsReg
toAbsReg Temp
r) Word8
0, () -> Label -> X86 AbsReg ()
forall reg a. a -> Label -> X86 reg a
Label () Label
l2 ]
    }
irEmit SizeEnv
_ (IR.MovTemp Temp
r1 (IR.ExprIntBinOp IntBinOp
IR.IntMinusIR (IR.Reg Temp
r2) (IR.ConstInt Int64
i))) | Temp
r1 Temp -> Temp -> Bool
forall a. Eq a => a -> a -> Bool
== Temp
r2 = do
    [X86 AbsReg ()] -> WriteM [X86 AbsReg ()]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [ () -> AbsReg -> Int64 -> X86 AbsReg ()
forall reg a. a -> reg -> Int64 -> X86 reg a
SubRC () (Temp -> AbsReg
toAbsReg Temp
r1) Int64
i ]
irEmit SizeEnv
_ (IR.MovTemp Temp
r1 (IR.ExprIntBinOp IntBinOp
IR.IntPlusIR (IR.Reg Temp
r2) (IR.ConstInt Int64
i))) | Temp
r1 Temp -> Temp -> Bool
forall a. Eq a => a -> a -> Bool
== Temp
r2 = do
    [X86 AbsReg ()] -> WriteM [X86 AbsReg ()]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [ () -> AbsReg -> Int64 -> X86 AbsReg ()
forall reg a. a -> reg -> Int64 -> X86 reg a
AddRC () (Temp -> AbsReg
toAbsReg Temp
r1) Int64
i ]
irEmit SizeEnv
env (IR.CCall ([KempeTy ()]
is, []) ByteString
b) | (KempeTy () -> Bool) -> [KempeTy ()] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (\KempeTy ()
i -> SizeEnv -> KempeTy () -> Int64
forall a. SizeEnv -> KempeTy a -> Int64
size' SizeEnv
env KempeTy ()
i Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
<= Int64
8) [KempeTy ()]
is Bool -> Bool -> Bool
&& [KempeTy ()] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [KempeTy ()]
is Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
6 =
    [X86 AbsReg ()] -> WriteM [X86 AbsReg ()]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [() -> ByteString -> X86 AbsReg ()
forall reg a. a -> ByteString -> X86 reg a
NasmMacro0 () ByteString
"callersave", () -> ByteString -> X86 AbsReg ()
forall reg a. a -> ByteString -> X86 reg a
CallBS () ByteString
b, () -> ByteString -> X86 AbsReg ()
forall reg a. a -> ByteString -> X86 reg a
NasmMacro0 () ByteString
"callerrestore"]
irEmit SizeEnv
env (IR.CCall ([KempeTy ()]
is, [KempeTy ()
o]) ByteString
b) | (KempeTy () -> Bool) -> [KempeTy ()] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (\KempeTy ()
i -> SizeEnv -> KempeTy () -> Int64
forall a. SizeEnv -> KempeTy a -> Int64
size' SizeEnv
env KempeTy ()
i Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
<= Int64
8) [KempeTy ()]
is Bool -> Bool -> Bool
&& SizeEnv -> KempeTy () -> Int64
forall a. SizeEnv -> KempeTy a -> Int64
size' SizeEnv
env KempeTy ()
o Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
<= Int64
8 Bool -> Bool -> Bool
&& [KempeTy ()] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [KempeTy ()]
is Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
6 =
    [X86 AbsReg ()] -> WriteM [X86 AbsReg ()]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [() -> ByteString -> X86 AbsReg ()
forall reg a. a -> ByteString -> X86 reg a
NasmMacro0 () ByteString
"callersave", () -> ByteString -> X86 AbsReg ()
forall reg a. a -> ByteString -> X86 reg a
CallBS () ByteString
b, () -> ByteString -> X86 AbsReg ()
forall reg a. a -> ByteString -> X86 reg a
NasmMacro0 () ByteString
"callerrestore"]
-- For 128-bit returns we'd have to use rax and rdx
irEmit SizeEnv
env (IR.WrapKCall ABI
Cabi ([KempeTy ()]
is, [KempeTy ()
o]) ByteString
n Label
l) | (KempeTy () -> Bool) -> [KempeTy ()] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (\KempeTy ()
i -> SizeEnv -> KempeTy () -> Int64
forall a. SizeEnv -> KempeTy a -> Int64
size' SizeEnv
env KempeTy ()
i Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
<= Int64
8) [KempeTy ()]
is Bool -> Bool -> Bool
&& SizeEnv -> KempeTy () -> Int64
forall a. SizeEnv -> KempeTy a -> Int64
size' SizeEnv
env KempeTy ()
o Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
<= Int64
8 Bool -> Bool -> Bool
&& [KempeTy ()] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [KempeTy ()]
is Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
6 = do
    { let offs :: [Int64]
offs = (Int64 -> Int64 -> Int64) -> Int64 -> [Int64] -> [Int64]
forall b a. (b -> a -> b) -> b -> [a] -> [b]
scanl' Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
(+) Int64
0 ((KempeTy () -> Int64) -> [KempeTy ()] -> [Int64]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (SizeEnv -> KempeTy () -> Int64
forall a. SizeEnv -> KempeTy a -> Int64
size' SizeEnv
env) [KempeTy ()]
is)
    ; let totalSize :: Int64
totalSize = SizeEnv -> [KempeTy ()] -> Int64
forall a. SizeEnv -> [KempeTy a] -> Int64
sizeStack SizeEnv
env [KempeTy ()]
is
    ; let argRegs :: [AbsReg]
argRegs = [AbsReg
CArg1, AbsReg
CArg2, AbsReg
CArg3, AbsReg
CArg4, AbsReg
CArg5, AbsReg
CArg6]
    ; [X86 AbsReg ()] -> WriteM [X86 AbsReg ()]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([X86 AbsReg ()] -> WriteM [X86 AbsReg ()])
-> [X86 AbsReg ()] -> WriteM [X86 AbsReg ()]
forall a b. (a -> b) -> a -> b
$ [() -> ByteString -> X86 AbsReg ()
forall reg a. a -> ByteString -> X86 reg a
BSLabel () ByteString
n, () -> AbsReg -> ByteString -> X86 AbsReg ()
forall reg a. a -> reg -> ByteString -> X86 reg a
MovRL () AbsReg
DataPointer ByteString
"kempe_data", () -> ByteString -> X86 AbsReg ()
forall reg a. a -> ByteString -> X86 reg a
NasmMacro0 () ByteString
"calleesave"] [X86 AbsReg ()] -> [X86 AbsReg ()] -> [X86 AbsReg ()]
forall a. [a] -> [a] -> [a]
++ (AbsReg -> Int64 -> X86 AbsReg ())
-> [AbsReg] -> [Int64] -> [X86 AbsReg ()]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\AbsReg
r Int64
i-> () -> Addr AbsReg -> AbsReg -> X86 AbsReg ()
forall reg a. a -> Addr reg -> reg -> X86 reg a
MovAR () (AbsReg -> Int64 -> Addr AbsReg
forall reg. reg -> Int64 -> Addr reg
AddrRCPlus AbsReg
DataPointer Int64
i) AbsReg
r) [AbsReg]
argRegs [Int64]
offs [X86 AbsReg ()] -> [X86 AbsReg ()] -> [X86 AbsReg ()]
forall a. [a] -> [a] -> [a]
++ [() -> AbsReg -> Int64 -> X86 AbsReg ()
forall reg a. a -> reg -> Int64 -> X86 reg a
AddRC () AbsReg
DataPointer Int64
totalSize, () -> Label -> X86 AbsReg ()
forall reg a. a -> Label -> X86 reg a
Call () Label
l, () -> AbsReg -> Addr AbsReg -> X86 AbsReg ()
forall reg a. a -> reg -> Addr reg -> X86 reg a
MovRA () AbsReg
CRet (AbsReg -> Int64 -> Addr AbsReg
forall reg. reg -> Int64 -> Addr reg
AddrRCMinus AbsReg
DataPointer (SizeEnv -> KempeTy () -> Int64
forall a. SizeEnv -> KempeTy a -> Int64
size' SizeEnv
env KempeTy ()
o)), () -> ByteString -> X86 AbsReg ()
forall reg a. a -> ByteString -> X86 reg a
NasmMacro0 () ByteString
"calleerestore", () -> X86 AbsReg ()
forall reg a. a -> X86 reg a
Ret ()] -- TODO: bytes on the stack eh
    }
irEmit SizeEnv
_ (IR.WrapKCall ABI
Kabi ([KempeTy ()]
_, [KempeTy ()]
_) ByteString
n Label
l) =
    [X86 AbsReg ()] -> WriteM [X86 AbsReg ()]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [() -> ByteString -> X86 AbsReg ()
forall reg a. a -> ByteString -> X86 reg a
BSLabel () ByteString
n, () -> Label -> X86 AbsReg ()
forall reg a. a -> Label -> X86 reg a
Call () Label
l, () -> X86 AbsReg ()
forall reg a. a -> X86 reg a
Ret ()]
irEmit SizeEnv
_ (IR.MovMem (IR.Reg Temp
r) Int64
_ (IR.ConstInt8 Int8
i)) =
    [X86 AbsReg ()] -> WriteM [X86 AbsReg ()]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [ () -> Addr AbsReg -> Int8 -> X86 AbsReg ()
forall reg a. a -> Addr reg -> Int8 -> X86 reg a
MovACi8 () (AbsReg -> Addr AbsReg
forall reg. reg -> Addr reg
Reg (AbsReg -> Addr AbsReg) -> AbsReg -> Addr AbsReg
forall a b. (a -> b) -> a -> b
$ Temp -> AbsReg
toAbsReg Temp
r) Int8
i ]
    -- see: https://github.com/cirosantilli/x86-assembly-cheat/blob/master/x86-64/movabs.asm for why we don't do this ^ for words
irEmit SizeEnv
_ (IR.MovMem (IR.Reg Temp
r) Int64
_ (IR.ExprIntBinOp IntBinOp
IR.IntXorIR (IR.Reg Temp
r1) (IR.Reg Temp
r2))) = do
    { AbsReg
r' <- WriteM AbsReg
allocReg64
    ; [X86 AbsReg ()] -> WriteM [X86 AbsReg ()]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [ () -> AbsReg -> AbsReg -> X86 AbsReg ()
forall reg a. a -> reg -> reg -> X86 reg a
MovRR () AbsReg
r' (Temp -> AbsReg
toAbsReg Temp
r1), () -> AbsReg -> AbsReg -> X86 AbsReg ()
forall reg a. a -> reg -> reg -> X86 reg a
XorRR () AbsReg
r' (Temp -> AbsReg
toAbsReg Temp
r2), () -> Addr AbsReg -> AbsReg -> X86 AbsReg ()
forall reg a. a -> Addr reg -> reg -> X86 reg a
MovAR () (AbsReg -> Addr AbsReg
forall reg. reg -> Addr reg
Reg (AbsReg -> Addr AbsReg) -> AbsReg -> Addr AbsReg
forall a b. (a -> b) -> a -> b
$ Temp -> AbsReg
toAbsReg Temp
r) AbsReg
r' ]
    }
irEmit SizeEnv
_ (IR.MovMem (IR.Reg Temp
r) Int64
_ (IR.ExprIntBinOp IntBinOp
IR.IntPlusIR (IR.Reg Temp
r1) (IR.Reg Temp
r2))) = do
    { AbsReg
r' <- WriteM AbsReg
allocReg64
    ; [X86 AbsReg ()] -> WriteM [X86 AbsReg ()]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [ () -> AbsReg -> AbsReg -> X86 AbsReg ()
forall reg a. a -> reg -> reg -> X86 reg a
MovRR () AbsReg
r' (Temp -> AbsReg
toAbsReg Temp
r1), () -> AbsReg -> AbsReg -> X86 AbsReg ()
forall reg a. a -> reg -> reg -> X86 reg a
AddRR () AbsReg
r' (Temp -> AbsReg
toAbsReg Temp
r2), () -> Addr AbsReg -> AbsReg -> X86 AbsReg ()
forall reg a. a -> Addr reg -> reg -> X86 reg a
MovAR () (AbsReg -> Addr AbsReg
forall reg. reg -> Addr reg
Reg (AbsReg -> Addr AbsReg) -> AbsReg -> Addr AbsReg
forall a b. (a -> b) -> a -> b
$ Temp -> AbsReg
toAbsReg Temp
r) AbsReg
r' ]
    }
irEmit SizeEnv
_ (IR.MovMem (IR.Reg Temp
r) Int64
_ (IR.ExprIntBinOp IntBinOp
IR.WordShiftRIR (IR.Reg Temp
r1) (IR.Reg Temp
r2))) = do
    { AbsReg
r' <- WriteM AbsReg
allocReg64
    ; [X86 AbsReg ()] -> WriteM [X86 AbsReg ()]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [ () -> AbsReg -> AbsReg -> X86 AbsReg ()
forall reg a. a -> reg -> reg -> X86 reg a
MovRR () AbsReg
ShiftExponent (Temp -> AbsReg
toAbsReg Temp
r2), () -> AbsReg -> AbsReg -> X86 AbsReg ()
forall reg a. a -> reg -> reg -> X86 reg a
MovRR () AbsReg
r' (Temp -> AbsReg
toAbsReg Temp
r1), () -> AbsReg -> AbsReg -> X86 AbsReg ()
forall reg a. a -> reg -> reg -> X86 reg a
ShiftRRR () AbsReg
r' AbsReg
ShiftExponent, () -> Addr AbsReg -> AbsReg -> X86 AbsReg ()
forall reg a. a -> Addr reg -> reg -> X86 reg a
MovAR () (AbsReg -> Addr AbsReg
forall reg. reg -> Addr reg
Reg (AbsReg -> Addr AbsReg) -> AbsReg -> Addr AbsReg
forall a b. (a -> b) -> a -> b
$ Temp -> AbsReg
toAbsReg Temp
r) AbsReg
r' ]
    }
irEmit SizeEnv
_ (IR.MovMem (IR.Reg Temp
r) Int64
_ (IR.ExprIntBinOp IntBinOp
IR.WordShiftLIR (IR.Reg Temp
r1) (IR.Reg Temp
r2))) = do
    { AbsReg
r' <- WriteM AbsReg
allocReg64
    ; [X86 AbsReg ()] -> WriteM [X86 AbsReg ()]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [ () -> AbsReg -> AbsReg -> X86 AbsReg ()
forall reg a. a -> reg -> reg -> X86 reg a
MovRR () AbsReg
ShiftExponent (Temp -> AbsReg
toAbsReg Temp
r2), () -> AbsReg -> AbsReg -> X86 AbsReg ()
forall reg a. a -> reg -> reg -> X86 reg a
MovRR () AbsReg
r' (Temp -> AbsReg
toAbsReg Temp
r1), () -> AbsReg -> AbsReg -> X86 AbsReg ()
forall reg a. a -> reg -> reg -> X86 reg a
ShiftLRR () AbsReg
r' AbsReg
ShiftExponent, () -> Addr AbsReg -> AbsReg -> X86 AbsReg ()
forall reg a. a -> Addr reg -> reg -> X86 reg a
MovAR () (AbsReg -> Addr AbsReg
forall reg. reg -> Addr reg
Reg (AbsReg -> Addr AbsReg) -> AbsReg -> Addr AbsReg
forall a b. (a -> b) -> a -> b
$ Temp -> AbsReg
toAbsReg Temp
r) AbsReg
r' ]
    }
irEmit SizeEnv
_ (IR.MovMem (IR.Reg Temp
r) Int64
_ (IR.ExprIntBinOp IntBinOp
IR.IntModIR (IR.Reg Temp
r1) (IR.Reg Temp
r2))) =
    -- QuotRes is rax, so move r1 to rax first
    [X86 AbsReg ()] -> WriteM [X86 AbsReg ()]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [ () -> AbsReg -> AbsReg -> X86 AbsReg ()
forall reg a. a -> reg -> reg -> X86 reg a
MovRR () AbsReg
QuotRes (Temp -> AbsReg
toAbsReg Temp
r1), () -> X86 AbsReg ()
forall reg a. a -> X86 reg a
Cqo (), () -> AbsReg -> X86 AbsReg ()
forall reg a. a -> reg -> X86 reg a
IdivR () (Temp -> AbsReg
toAbsReg Temp
r2), () -> Addr AbsReg -> AbsReg -> X86 AbsReg ()
forall reg a. a -> Addr reg -> reg -> X86 reg a
MovAR () (AbsReg -> Addr AbsReg
forall reg. reg -> Addr reg
Reg (AbsReg -> Addr AbsReg) -> AbsReg -> Addr AbsReg
forall a b. (a -> b) -> a -> b
$ Temp -> AbsReg
toAbsReg Temp
r) AbsReg
RemRes ]
irEmit SizeEnv
_ (IR.MovTemp Temp
r Exp
e) = Exp -> Temp -> WriteM [X86 AbsReg ()]
evalE Exp
e Temp
r
irEmit SizeEnv
_ (IR.MovMem (IR.Reg Temp
r) Int64
1 Exp
e) = do
    { Temp
r' <- WriteM Temp
allocTemp8
    ; [X86 AbsReg ()]
put <- Exp -> Temp -> WriteM [X86 AbsReg ()]
evalE Exp
e Temp
r'
    ; [X86 AbsReg ()] -> WriteM [X86 AbsReg ()]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([X86 AbsReg ()] -> WriteM [X86 AbsReg ()])
-> [X86 AbsReg ()] -> WriteM [X86 AbsReg ()]
forall a b. (a -> b) -> a -> b
$ [X86 AbsReg ()]
put [X86 AbsReg ()] -> [X86 AbsReg ()] -> [X86 AbsReg ()]
forall a. [a] -> [a] -> [a]
++ [() -> Addr AbsReg -> AbsReg -> X86 AbsReg ()
forall reg a. a -> Addr reg -> reg -> X86 reg a
MovAR () (AbsReg -> Addr AbsReg
forall reg. reg -> Addr reg
Reg (AbsReg -> Addr AbsReg) -> AbsReg -> Addr AbsReg
forall a b. (a -> b) -> a -> b
$ Temp -> AbsReg
toAbsReg Temp
r) (Temp -> AbsReg
toAbsReg Temp
r')]
    }
irEmit SizeEnv
_ (IR.MovMem Exp
e Int64
8 Exp
e') = do
    { Temp
r <- WriteM Temp
allocTemp64
    ; Temp
r' <- WriteM Temp
allocTemp64
    ; [X86 AbsReg ()]
eEval <- Exp -> Temp -> WriteM [X86 AbsReg ()]
evalE Exp
e Temp
r
    ; [X86 AbsReg ()]
e'Eval <- Exp -> Temp -> WriteM [X86 AbsReg ()]
evalE Exp
e' Temp
r'
    ; [X86 AbsReg ()] -> WriteM [X86 AbsReg ()]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([X86 AbsReg ()]
eEval [X86 AbsReg ()] -> [X86 AbsReg ()] -> [X86 AbsReg ()]
forall a. [a] -> [a] -> [a]
++ [X86 AbsReg ()]
e'Eval [X86 AbsReg ()] -> [X86 AbsReg ()] -> [X86 AbsReg ()]
forall a. [a] -> [a] -> [a]
++ [() -> Addr AbsReg -> AbsReg -> X86 AbsReg ()
forall reg a. a -> Addr reg -> reg -> X86 reg a
MovAR () (AbsReg -> Addr AbsReg
forall reg. reg -> Addr reg
Reg (AbsReg -> Addr AbsReg) -> AbsReg -> Addr AbsReg
forall a b. (a -> b) -> a -> b
$ Temp -> AbsReg
toAbsReg Temp
r) (Temp -> AbsReg
toAbsReg Temp
r')])
    }
irEmit SizeEnv
_ (IR.MovMem Exp
e Int64
1 Exp
e') = do
    { Temp
r <- WriteM Temp
allocTemp64
    ; Temp
r' <- WriteM Temp
allocTemp8
    ; [X86 AbsReg ()]
eEval <- Exp -> Temp -> WriteM [X86 AbsReg ()]
evalE Exp
e Temp
r
    ; [X86 AbsReg ()]
e'Eval <- Exp -> Temp -> WriteM [X86 AbsReg ()]
evalE Exp
e' Temp
r'
    ; [X86 AbsReg ()] -> WriteM [X86 AbsReg ()]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([X86 AbsReg ()]
eEval [X86 AbsReg ()] -> [X86 AbsReg ()] -> [X86 AbsReg ()]
forall a. [a] -> [a] -> [a]
++ [X86 AbsReg ()]
e'Eval [X86 AbsReg ()] -> [X86 AbsReg ()] -> [X86 AbsReg ()]
forall a. [a] -> [a] -> [a]
++ [() -> Addr AbsReg -> AbsReg -> X86 AbsReg ()
forall reg a. a -> Addr reg -> reg -> X86 reg a
MovAR () (AbsReg -> Addr AbsReg
forall reg. reg -> Addr reg
Reg (AbsReg -> Addr AbsReg) -> AbsReg -> Addr AbsReg
forall a b. (a -> b) -> a -> b
$ Temp -> AbsReg
toAbsReg Temp
r) (Temp -> AbsReg
toAbsReg Temp
r')])
    }
irEmit SizeEnv
_ (IR.CJump (IR.Mem Int64
1 (IR.Reg Temp
r)) Label
l Label
l') =
    [X86 AbsReg ()] -> WriteM [X86 AbsReg ()]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [() -> Addr AbsReg -> Word8 -> X86 AbsReg ()
forall reg a. a -> Addr reg -> Word8 -> X86 reg a
CmpAddrBool () (AbsReg -> Addr AbsReg
forall reg. reg -> Addr reg
Reg (Temp -> AbsReg
toAbsReg Temp
r)) Word8
1, () -> Label -> X86 AbsReg ()
forall reg a. a -> Label -> X86 reg a
Je () Label
l, () -> Label -> X86 AbsReg ()
forall reg a. a -> Label -> X86 reg a
Jump () Label
l']
irEmit SizeEnv
_ (IR.MJump (IR.Mem Int64
1 (IR.Reg Temp
r)) Label
l) =
    [X86 AbsReg ()] -> WriteM [X86 AbsReg ()]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [() -> Addr AbsReg -> Word8 -> X86 AbsReg ()
forall reg a. a -> Addr reg -> Word8 -> X86 reg a
CmpAddrBool () (AbsReg -> Addr AbsReg
forall reg. reg -> Addr reg
Reg (Temp -> AbsReg
toAbsReg Temp
r)) Word8
1, () -> Label -> X86 AbsReg ()
forall reg a. a -> Label -> X86 reg a
Je () Label
l]
irEmit SizeEnv
_ (IR.CJump (IR.Mem Int64
1 (IR.ExprIntBinOp IntBinOp
IR.IntMinusIR (IR.Reg Temp
r) (IR.ConstInt Int64
i))) Label
l Label
l') =
    [X86 AbsReg ()] -> WriteM [X86 AbsReg ()]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [() -> Addr AbsReg -> Word8 -> X86 AbsReg ()
forall reg a. a -> Addr reg -> Word8 -> X86 reg a
CmpAddrBool () (AbsReg -> Int64 -> Addr AbsReg
forall reg. reg -> Int64 -> Addr reg
AddrRCMinus (Temp -> AbsReg
toAbsReg Temp
r) Int64
i) Word8
1, () -> Label -> X86 AbsReg ()
forall reg a. a -> Label -> X86 reg a
Je () Label
l, () -> Label -> X86 AbsReg ()
forall reg a. a -> Label -> X86 reg a
Jump () Label
l']
irEmit SizeEnv
_ (IR.MJump (IR.Mem Int64
1 (IR.ExprIntBinOp IntBinOp
IR.IntMinusIR (IR.Reg Temp
r) (IR.ConstInt Int64
i))) Label
l) =
    [X86 AbsReg ()] -> WriteM [X86 AbsReg ()]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [() -> Addr AbsReg -> Word8 -> X86 AbsReg ()
forall reg a. a -> Addr reg -> Word8 -> X86 reg a
CmpAddrBool () (AbsReg -> Int64 -> Addr AbsReg
forall reg. reg -> Int64 -> Addr reg
AddrRCMinus (Temp -> AbsReg
toAbsReg Temp
r) Int64
i) Word8
1, () -> Label -> X86 AbsReg ()
forall reg a. a -> Label -> X86 reg a
Je () Label
l]
irEmit SizeEnv
_ (IR.CJump (IR.Mem Int64
1 (IR.ExprIntBinOp IntBinOp
IR.IntPlusIR (IR.Reg Temp
r) (IR.ConstInt Int64
i))) Label
l Label
l') =
    [X86 AbsReg ()] -> WriteM [X86 AbsReg ()]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [() -> Addr AbsReg -> Word8 -> X86 AbsReg ()
forall reg a. a -> Addr reg -> Word8 -> X86 reg a
CmpAddrBool () (AbsReg -> Int64 -> Addr AbsReg
forall reg. reg -> Int64 -> Addr reg
AddrRCPlus (Temp -> AbsReg
toAbsReg Temp
r) Int64
i) Word8
1, () -> Label -> X86 AbsReg ()
forall reg a. a -> Label -> X86 reg a
Je () Label
l, () -> Label -> X86 AbsReg ()
forall reg a. a -> Label -> X86 reg a
Jump () Label
l']
irEmit SizeEnv
_ (IR.MJump (IR.Mem Int64
1 (IR.ExprIntBinOp IntBinOp
IR.IntPlusIR (IR.Reg Temp
r) (IR.ConstInt Int64
i))) Label
l) =
    [X86 AbsReg ()] -> WriteM [X86 AbsReg ()]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [() -> Addr AbsReg -> Word8 -> X86 AbsReg ()
forall reg a. a -> Addr reg -> Word8 -> X86 reg a
CmpAddrBool () (AbsReg -> Int64 -> Addr AbsReg
forall reg. reg -> Int64 -> Addr reg
AddrRCPlus (Temp -> AbsReg
toAbsReg Temp
r) Int64
i) Word8
1, () -> Label -> X86 AbsReg ()
forall reg a. a -> Label -> X86 reg a
Je () Label
l]
irEmit SizeEnv
_ (IR.CJump Exp
e Label
l Label
l') = do
    { Temp
r <- WriteM Temp
allocTemp8
    ; [X86 AbsReg ()]
bEval <- Exp -> Temp -> WriteM [X86 AbsReg ()]
evalE Exp
e Temp
r
    ; [X86 AbsReg ()] -> WriteM [X86 AbsReg ()]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([X86 AbsReg ()]
bEval [X86 AbsReg ()] -> [X86 AbsReg ()] -> [X86 AbsReg ()]
forall a. [a] -> [a] -> [a]
++ [() -> AbsReg -> Word8 -> X86 AbsReg ()
forall reg a. a -> reg -> Word8 -> X86 reg a
CmpRegBool () (Temp -> AbsReg
toAbsReg Temp
r) Word8
1, () -> Label -> X86 AbsReg ()
forall reg a. a -> Label -> X86 reg a
Je () Label
l, () -> Label -> X86 AbsReg ()
forall reg a. a -> Label -> X86 reg a
Jump () Label
l'])
    }
irEmit SizeEnv
_ (IR.MJump (IR.EqByte (IR.Mem Int64
1 (IR.Reg Temp
r)) (IR.ConstTag Word8
b)) Label
l) =
    [X86 AbsReg ()] -> WriteM [X86 AbsReg ()]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [() -> Addr AbsReg -> Word8 -> X86 AbsReg ()
forall reg a. a -> Addr reg -> Word8 -> X86 reg a
CmpAddrBool () (AbsReg -> Addr AbsReg
forall reg. reg -> Addr reg
Reg (AbsReg -> Addr AbsReg) -> AbsReg -> Addr AbsReg
forall a b. (a -> b) -> a -> b
$ Temp -> AbsReg
toAbsReg Temp
r) Word8
b, () -> Label -> X86 AbsReg ()
forall reg a. a -> Label -> X86 reg a
Je () Label
l]
irEmit SizeEnv
_ (IR.MJump (IR.EqByte Exp
e0 Exp
e1) Label
l) = do
    { Temp
r0 <- WriteM Temp
allocTemp8
    ; Temp
r1 <- WriteM Temp
allocTemp8
    ; [X86 AbsReg ()]
placeE0 <- Exp -> Temp -> WriteM [X86 AbsReg ()]
evalE Exp
e0 Temp
r0
    ; [X86 AbsReg ()]
placeE1 <- Exp -> Temp -> WriteM [X86 AbsReg ()]
evalE Exp
e1 Temp
r1
    ; [X86 AbsReg ()] -> WriteM [X86 AbsReg ()]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([X86 AbsReg ()] -> WriteM [X86 AbsReg ()])
-> [X86 AbsReg ()] -> WriteM [X86 AbsReg ()]
forall a b. (a -> b) -> a -> b
$ [X86 AbsReg ()]
placeE0 [X86 AbsReg ()] -> [X86 AbsReg ()] -> [X86 AbsReg ()]
forall a. [a] -> [a] -> [a]
++ [X86 AbsReg ()]
placeE1 [X86 AbsReg ()] -> [X86 AbsReg ()] -> [X86 AbsReg ()]
forall a. [a] -> [a] -> [a]
++ [() -> AbsReg -> AbsReg -> X86 AbsReg ()
forall reg a. a -> reg -> reg -> X86 reg a
CmpRegReg () (Temp -> AbsReg
toAbsReg Temp
r0) (Temp -> AbsReg
toAbsReg Temp
r1), () -> Label -> X86 AbsReg ()
forall reg a. a -> Label -> X86 reg a
Je () Label
l]
    }
irEmit SizeEnv
_ (IR.MJump Exp
e Label
l) = do
    { Temp
r <- WriteM Temp
allocTemp8
    ; [X86 AbsReg ()]
bEval <- Exp -> Temp -> WriteM [X86 AbsReg ()]
evalE Exp
e Temp
r
    ; [X86 AbsReg ()] -> WriteM [X86 AbsReg ()]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([X86 AbsReg ()]
bEval [X86 AbsReg ()] -> [X86 AbsReg ()] -> [X86 AbsReg ()]
forall a. [a] -> [a] -> [a]
++ [() -> AbsReg -> Word8 -> X86 AbsReg ()
forall reg a. a -> reg -> Word8 -> X86 reg a
CmpRegBool () (Temp -> AbsReg
toAbsReg Temp
r) Word8
1, () -> Label -> X86 AbsReg ()
forall reg a. a -> Label -> X86 reg a
Je () Label
l])
    }

-- | Code to evaluate and put some expression in a chosen 'Temp'
--
-- This more or less conforms to maximal munch.
evalE :: IR.Exp -> IR.Temp -> WriteM [X86 AbsReg ()]
evalE :: Exp -> Temp -> WriteM [X86 AbsReg ()]
evalE (IR.ConstInt Int64
i) Temp
r                                             = [X86 AbsReg ()] -> WriteM [X86 AbsReg ()]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [() -> AbsReg -> Int64 -> X86 AbsReg ()
forall reg a. a -> reg -> Int64 -> X86 reg a
MovRC () (Temp -> AbsReg
toAbsReg Temp
r) Int64
i]
evalE (IR.ConstBool Bool
b) Temp
r                                            = [X86 AbsReg ()] -> WriteM [X86 AbsReg ()]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [() -> AbsReg -> Word8 -> X86 AbsReg ()
forall reg a. a -> reg -> Word8 -> X86 reg a
MovRCBool () (Temp -> AbsReg
toAbsReg Temp
r) (Bool -> Word8
toByte Bool
b)]
evalE (IR.ConstInt8 Int8
i) Temp
r                                            = [X86 AbsReg ()] -> WriteM [X86 AbsReg ()]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [() -> AbsReg -> Int8 -> X86 AbsReg ()
forall reg a. a -> reg -> Int8 -> X86 reg a
MovRCi8 () (Temp -> AbsReg
toAbsReg Temp
r) Int8
i]
evalE (IR.ConstWord Label
w) Temp
r                                            = [X86 AbsReg ()] -> WriteM [X86 AbsReg ()]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [() -> AbsReg -> Label -> X86 AbsReg ()
forall reg a. a -> reg -> Label -> X86 reg a
MovRWord () (Temp -> AbsReg
toAbsReg Temp
r) Label
w]
evalE (IR.ConstTag Word8
b) Temp
r                                             = [X86 AbsReg ()] -> WriteM [X86 AbsReg ()]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [() -> AbsReg -> Word8 -> X86 AbsReg ()
forall reg a. a -> reg -> Word8 -> X86 reg a
MovRCTag () (Temp -> AbsReg
toAbsReg Temp
r) Word8
b]
evalE (IR.Reg Temp
r') Temp
r                                                 = [X86 AbsReg ()] -> WriteM [X86 AbsReg ()]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [() -> AbsReg -> AbsReg -> X86 AbsReg ()
forall reg a. a -> reg -> reg -> X86 reg a
MovRR () (Temp -> AbsReg
toAbsReg Temp
r) (Temp -> AbsReg
toAbsReg Temp
r')]
evalE (IR.Mem Int64
_ (IR.Reg Temp
r1)) Temp
r                                      = [X86 AbsReg ()] -> WriteM [X86 AbsReg ()]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [() -> AbsReg -> Addr AbsReg -> X86 AbsReg ()
forall reg a. a -> reg -> Addr reg -> X86 reg a
MovRA () (Temp -> AbsReg
toAbsReg Temp
r) (AbsReg -> Addr AbsReg
forall reg. reg -> Addr reg
Reg (AbsReg -> Addr AbsReg) -> AbsReg -> Addr AbsReg
forall a b. (a -> b) -> a -> b
$ Temp -> AbsReg
toAbsReg Temp
r1) ] -- TODO: sanity check reg/mem access size?
evalE (IR.ExprIntBinOp IntBinOp
IR.IntMinusIR (IR.Reg Temp
r1) (IR.ConstInt Int64
i)) Temp
r | Temp
r Temp -> Temp -> Bool
forall a. Eq a => a -> a -> Bool
== Temp
r1 = [X86 AbsReg ()] -> WriteM [X86 AbsReg ()]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [() -> AbsReg -> Int64 -> X86 AbsReg ()
forall reg a. a -> reg -> Int64 -> X86 reg a
SubRC () (Temp -> AbsReg
toAbsReg Temp
r) Int64
i]
evalE (IR.ExprIntBinOp IntBinOp
IR.IntPlusIR (IR.Reg Temp
r1) (IR.ConstInt Int64
i)) Temp
r  | Temp
r Temp -> Temp -> Bool
forall a. Eq a => a -> a -> Bool
== Temp
r1 = [X86 AbsReg ()] -> WriteM [X86 AbsReg ()]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [() -> AbsReg -> Int64 -> X86 AbsReg ()
forall reg a. a -> reg -> Int64 -> X86 reg a
AddRC () (Temp -> AbsReg
toAbsReg Temp
r) Int64
i]
evalE (IR.ExprIntBinOp IntBinOp
IR.IntMinusIR (IR.Reg Temp
r1) (IR.ConstInt Int64
0)) Temp
r = [X86 AbsReg ()] -> WriteM [X86 AbsReg ()]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [() -> AbsReg -> AbsReg -> X86 AbsReg ()
forall reg a. a -> reg -> reg -> X86 reg a
MovRR () (Temp -> AbsReg
toAbsReg Temp
r) (Temp -> AbsReg
toAbsReg Temp
r1)]
evalE (IR.Mem Int64
8 (IR.ExprIntBinOp IntBinOp
IR.IntMinusIR (IR.Reg Temp
r1) (IR.ConstInt Int64
i))) Temp
r =
    [X86 AbsReg ()] -> WriteM [X86 AbsReg ()]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [ () -> AbsReg -> Addr AbsReg -> X86 AbsReg ()
forall reg a. a -> reg -> Addr reg -> X86 reg a
MovRA () (Temp -> AbsReg
toAbsReg Temp
r) (AbsReg -> Int64 -> Addr AbsReg
forall reg. reg -> Int64 -> Addr reg
AddrRCMinus (Temp -> AbsReg
toAbsReg Temp
r1) Int64
i) ]
evalE (IR.Mem Int64
8 (IR.ExprIntBinOp IntBinOp
IR.IntPlusIR (IR.Reg Temp
r1) (IR.ConstInt Int64
i))) Temp
r =
    [X86 AbsReg ()] -> WriteM [X86 AbsReg ()]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [ () -> AbsReg -> Addr AbsReg -> X86 AbsReg ()
forall reg a. a -> reg -> Addr reg -> X86 reg a
MovRA () (Temp -> AbsReg
toAbsReg Temp
r) (AbsReg -> Int64 -> Addr AbsReg
forall reg. reg -> Int64 -> Addr reg
AddrRCPlus (Temp -> AbsReg
toAbsReg Temp
r1) Int64
i) ]
evalE (IR.Mem Int64
_ Exp
e) Temp
r = do -- don't need to check size b/c we're storing in r
    { Temp
r' <- WriteM Temp
allocTemp64
    ; [X86 AbsReg ()]
placeE <- Exp -> Temp -> WriteM [X86 AbsReg ()]
evalE Exp
e Temp
r'
    ; [X86 AbsReg ()] -> WriteM [X86 AbsReg ()]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([X86 AbsReg ()] -> WriteM [X86 AbsReg ()])
-> [X86 AbsReg ()] -> WriteM [X86 AbsReg ()]
forall a b. (a -> b) -> a -> b
$ [X86 AbsReg ()]
placeE [X86 AbsReg ()] -> [X86 AbsReg ()] -> [X86 AbsReg ()]
forall a. [a] -> [a] -> [a]
++ [() -> AbsReg -> Addr AbsReg -> X86 AbsReg ()
forall reg a. a -> reg -> Addr reg -> X86 reg a
MovRA () (Temp -> AbsReg
toAbsReg Temp
r) (AbsReg -> Addr AbsReg
forall reg. reg -> Addr reg
Reg (AbsReg -> Addr AbsReg) -> AbsReg -> Addr AbsReg
forall a b. (a -> b) -> a -> b
$ Temp -> AbsReg
toAbsReg Temp
r')]
    }
evalE (IR.ExprIntBinOp IntBinOp
IR.IntPlusIR (IR.Reg Temp
r1) (IR.Reg Temp
r2)) Temp
r =
    [X86 AbsReg ()] -> WriteM [X86 AbsReg ()]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [ () -> AbsReg -> AbsReg -> X86 AbsReg ()
forall reg a. a -> reg -> reg -> X86 reg a
MovRR () (Temp -> AbsReg
toAbsReg Temp
r) (Temp -> AbsReg
toAbsReg Temp
r1), () -> AbsReg -> AbsReg -> X86 AbsReg ()
forall reg a. a -> reg -> reg -> X86 reg a
AddRR () (Temp -> AbsReg
toAbsReg Temp
r) (Temp -> AbsReg
toAbsReg Temp
r2) ]
evalE (IR.ExprIntBinOp IntBinOp
IR.IntTimesIR (IR.Reg Temp
r1) (IR.Reg Temp
r2)) Temp
r = do
    [X86 AbsReg ()] -> WriteM [X86 AbsReg ()]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [ () -> AbsReg -> AbsReg -> X86 AbsReg ()
forall reg a. a -> reg -> reg -> X86 reg a
MovRR () (Temp -> AbsReg
toAbsReg Temp
r) (Temp -> AbsReg
toAbsReg Temp
r1), () -> AbsReg -> AbsReg -> X86 AbsReg ()
forall reg a. a -> reg -> reg -> X86 reg a
ImulRR () (Temp -> AbsReg
toAbsReg Temp
r) (Temp -> AbsReg
toAbsReg Temp
r2) ]
evalE (IR.ExprIntBinOp IntBinOp
IR.IntXorIR (IR.Reg Temp
r1) (IR.Reg Temp
r2)) Temp
r = do
    [X86 AbsReg ()] -> WriteM [X86 AbsReg ()]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [ () -> AbsReg -> AbsReg -> X86 AbsReg ()
forall reg a. a -> reg -> reg -> X86 reg a
MovRR () (Temp -> AbsReg
toAbsReg Temp
r) (Temp -> AbsReg
toAbsReg Temp
r1), () -> AbsReg -> AbsReg -> X86 AbsReg ()
forall reg a. a -> reg -> reg -> X86 reg a
XorRR () (Temp -> AbsReg
toAbsReg Temp
r) (Temp -> AbsReg
toAbsReg Temp
r2) ]
evalE (IR.ExprIntBinOp IntBinOp
IR.IntMinusIR (IR.Reg Temp
r1) (IR.ConstInt Int64
i)) Temp
r = do
    [X86 AbsReg ()] -> WriteM [X86 AbsReg ()]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [ () -> AbsReg -> AbsReg -> X86 AbsReg ()
forall reg a. a -> reg -> reg -> X86 reg a
MovRR () (Temp -> AbsReg
toAbsReg Temp
r) (Temp -> AbsReg
toAbsReg Temp
r1), () -> AbsReg -> Int64 -> X86 AbsReg ()
forall reg a. a -> reg -> Int64 -> X86 reg a
SubRC () (Temp -> AbsReg
toAbsReg Temp
r) Int64
i ]
evalE (IR.ExprIntBinOp IntBinOp
IR.IntMinusIR (IR.Reg Temp
r1) (IR.Reg Temp
r2)) Temp
r = do
    [X86 AbsReg ()] -> WriteM [X86 AbsReg ()]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [ () -> AbsReg -> AbsReg -> X86 AbsReg ()
forall reg a. a -> reg -> reg -> X86 reg a
MovRR () (Temp -> AbsReg
toAbsReg Temp
r) (Temp -> AbsReg
toAbsReg Temp
r1), () -> AbsReg -> AbsReg -> X86 AbsReg ()
forall reg a. a -> reg -> reg -> X86 reg a
SubRR () (Temp -> AbsReg
toAbsReg Temp
r) (Temp -> AbsReg
toAbsReg Temp
r2) ]
-- FIXME: because my linear register allocator is shitty, I can't keep
-- registers across jumps... so evaluating = or < as an expression in
-- general is hard ?
evalE (IR.ExprIntBinOp IntBinOp
IR.WordShiftLIR (IR.Reg Temp
r1) (IR.Reg Temp
r2)) Temp
r =
    [X86 AbsReg ()] -> WriteM [X86 AbsReg ()]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [ () -> AbsReg -> AbsReg -> X86 AbsReg ()
forall reg a. a -> reg -> reg -> X86 reg a
MovRR () AbsReg
ShiftExponent (Temp -> AbsReg
toAbsReg Temp
r2), () -> AbsReg -> AbsReg -> X86 AbsReg ()
forall reg a. a -> reg -> reg -> X86 reg a
MovRR () (Temp -> AbsReg
toAbsReg Temp
r) (Temp -> AbsReg
toAbsReg Temp
r1), () -> AbsReg -> AbsReg -> X86 AbsReg ()
forall reg a. a -> reg -> reg -> X86 reg a
ShiftLRR () (Temp -> AbsReg
toAbsReg Temp
r) AbsReg
ShiftExponent ]
evalE (IR.ExprIntBinOp IntBinOp
IR.WordShiftRIR (IR.Reg Temp
r1) (IR.Reg Temp
r2)) Temp
r = -- FIXME: maximal munch use evalE recursively
    [X86 AbsReg ()] -> WriteM [X86 AbsReg ()]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [ () -> AbsReg -> AbsReg -> X86 AbsReg ()
forall reg a. a -> reg -> reg -> X86 reg a
MovRR () AbsReg
ShiftExponent (Temp -> AbsReg
toAbsReg Temp
r2), () -> AbsReg -> AbsReg -> X86 AbsReg ()
forall reg a. a -> reg -> reg -> X86 reg a
MovRR () (Temp -> AbsReg
toAbsReg Temp
r) (Temp -> AbsReg
toAbsReg Temp
r1), () -> AbsReg -> AbsReg -> X86 AbsReg ()
forall reg a. a -> reg -> reg -> X86 reg a
ShiftRRR () (Temp -> AbsReg
toAbsReg Temp
r) AbsReg
ShiftExponent]
evalE (IR.ExprIntBinOp IntBinOp
IR.WordShiftLIR Exp
e0 Exp
e1) Temp
r = do
    { Temp
r0 <- WriteM Temp
allocTemp64
    ; Temp
r1 <- WriteM Temp
allocTemp8
    ; [X86 AbsReg ()]
placeE0 <- Exp -> Temp -> WriteM [X86 AbsReg ()]
evalE Exp
e0 Temp
r0
    ; [X86 AbsReg ()]
placeE1 <- Exp -> Temp -> WriteM [X86 AbsReg ()]
evalE Exp
e1 Temp
r1
    ; [X86 AbsReg ()] -> WriteM [X86 AbsReg ()]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([X86 AbsReg ()] -> WriteM [X86 AbsReg ()])
-> [X86 AbsReg ()] -> WriteM [X86 AbsReg ()]
forall a b. (a -> b) -> a -> b
$ [X86 AbsReg ()]
placeE0 [X86 AbsReg ()] -> [X86 AbsReg ()] -> [X86 AbsReg ()]
forall a. [a] -> [a] -> [a]
++ [X86 AbsReg ()]
placeE1 [X86 AbsReg ()] -> [X86 AbsReg ()] -> [X86 AbsReg ()]
forall a. [a] -> [a] -> [a]
++ [ () -> AbsReg -> AbsReg -> X86 AbsReg ()
forall reg a. a -> reg -> reg -> X86 reg a
MovRR () AbsReg
ShiftExponent (Temp -> AbsReg
toAbsReg Temp
r0), () -> AbsReg -> AbsReg -> X86 AbsReg ()
forall reg a. a -> reg -> reg -> X86 reg a
MovRR () (Temp -> AbsReg
toAbsReg Temp
r) (Temp -> AbsReg
toAbsReg Temp
r1), () -> AbsReg -> AbsReg -> X86 AbsReg ()
forall reg a. a -> reg -> reg -> X86 reg a
ShiftLRR () (Temp -> AbsReg
toAbsReg Temp
r) AbsReg
ShiftExponent ]
    }
evalE (IR.ExprIntBinOp IntBinOp
IR.WordShiftRIR Exp
e0 Exp
e1) Temp
r = do
    { Temp
r0 <- WriteM Temp
allocTemp64
    ; Temp
r1 <- WriteM Temp
allocTemp8
    ; [X86 AbsReg ()]
placeE0 <- Exp -> Temp -> WriteM [X86 AbsReg ()]
evalE Exp
e0 Temp
r0
    ; [X86 AbsReg ()]
placeE1 <- Exp -> Temp -> WriteM [X86 AbsReg ()]
evalE Exp
e1 Temp
r1
    ; [X86 AbsReg ()] -> WriteM [X86 AbsReg ()]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([X86 AbsReg ()] -> WriteM [X86 AbsReg ()])
-> [X86 AbsReg ()] -> WriteM [X86 AbsReg ()]
forall a b. (a -> b) -> a -> b
$ [X86 AbsReg ()]
placeE0 [X86 AbsReg ()] -> [X86 AbsReg ()] -> [X86 AbsReg ()]
forall a. [a] -> [a] -> [a]
++ [X86 AbsReg ()]
placeE1 [X86 AbsReg ()] -> [X86 AbsReg ()] -> [X86 AbsReg ()]
forall a. [a] -> [a] -> [a]
++ [ () -> AbsReg -> AbsReg -> X86 AbsReg ()
forall reg a. a -> reg -> reg -> X86 reg a
MovRR () AbsReg
ShiftExponent (Temp -> AbsReg
toAbsReg Temp
r0), () -> AbsReg -> AbsReg -> X86 AbsReg ()
forall reg a. a -> reg -> reg -> X86 reg a
MovRR () (Temp -> AbsReg
toAbsReg Temp
r) (Temp -> AbsReg
toAbsReg Temp
r1), () -> AbsReg -> AbsReg -> X86 AbsReg ()
forall reg a. a -> reg -> reg -> X86 reg a
ShiftRRR () (Temp -> AbsReg
toAbsReg Temp
r) AbsReg
ShiftExponent ]
    }
evalE (IR.ExprIntBinOp IntBinOp
IR.IntModIR Exp
e0 Exp
e1) Temp
r = do
    { Temp
r0 <- WriteM Temp
allocTemp64
    ; Temp
r1 <- WriteM Temp
allocTemp64
    ; [X86 AbsReg ()]
placeE <- Exp -> Temp -> WriteM [X86 AbsReg ()]
evalE Exp
e0 Temp
r0
    ; [X86 AbsReg ()]
placeE' <- Exp -> Temp -> WriteM [X86 AbsReg ()]
evalE Exp
e1 Temp
r1
    -- QuotRes is rax, so move r1 to rax first
    ; [X86 AbsReg ()] -> WriteM [X86 AbsReg ()]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([X86 AbsReg ()] -> WriteM [X86 AbsReg ()])
-> [X86 AbsReg ()] -> WriteM [X86 AbsReg ()]
forall a b. (a -> b) -> a -> b
$ [X86 AbsReg ()]
placeE [X86 AbsReg ()] -> [X86 AbsReg ()] -> [X86 AbsReg ()]
forall a. [a] -> [a] -> [a]
++ [X86 AbsReg ()]
placeE' [X86 AbsReg ()] -> [X86 AbsReg ()] -> [X86 AbsReg ()]
forall a. [a] -> [a] -> [a]
++ [ () -> AbsReg -> AbsReg -> X86 AbsReg ()
forall reg a. a -> reg -> reg -> X86 reg a
MovRR () AbsReg
QuotRes (Temp -> AbsReg
toAbsReg Temp
r0), () -> X86 AbsReg ()
forall reg a. a -> X86 reg a
Cqo (), () -> AbsReg -> X86 AbsReg ()
forall reg a. a -> reg -> X86 reg a
IdivR () (Temp -> AbsReg
toAbsReg Temp
r1), () -> AbsReg -> AbsReg -> X86 AbsReg ()
forall reg a. a -> reg -> reg -> X86 reg a
MovRR () (Temp -> AbsReg
toAbsReg Temp
r) AbsReg
RemRes ]
    }
evalE (IR.ExprIntBinOp IntBinOp
IR.IntDivIR Exp
e0 Exp
e1) Temp
r = do
    { Temp
r0 <- WriteM Temp
allocTemp64
    ; Temp
r1 <- WriteM Temp
allocTemp64
    ; [X86 AbsReg ()]
placeE <- Exp -> Temp -> WriteM [X86 AbsReg ()]
evalE Exp
e0 Temp
r0
    ; [X86 AbsReg ()]
placeE' <- Exp -> Temp -> WriteM [X86 AbsReg ()]
evalE Exp
e1 Temp
r1
    ; [X86 AbsReg ()] -> WriteM [X86 AbsReg ()]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([X86 AbsReg ()] -> WriteM [X86 AbsReg ()])
-> [X86 AbsReg ()] -> WriteM [X86 AbsReg ()]
forall a b. (a -> b) -> a -> b
$ [X86 AbsReg ()]
placeE [X86 AbsReg ()] -> [X86 AbsReg ()] -> [X86 AbsReg ()]
forall a. [a] -> [a] -> [a]
++ [X86 AbsReg ()]
placeE' [X86 AbsReg ()] -> [X86 AbsReg ()] -> [X86 AbsReg ()]
forall a. [a] -> [a] -> [a]
++ [ () -> AbsReg -> AbsReg -> X86 AbsReg ()
forall reg a. a -> reg -> reg -> X86 reg a
MovRR () AbsReg
QuotRes (Temp -> AbsReg
toAbsReg Temp
r0), () -> X86 AbsReg ()
forall reg a. a -> X86 reg a
Cqo (), () -> AbsReg -> X86 AbsReg ()
forall reg a. a -> reg -> X86 reg a
IdivR () (Temp -> AbsReg
toAbsReg Temp
r1), () -> AbsReg -> AbsReg -> X86 AbsReg ()
forall reg a. a -> reg -> reg -> X86 reg a
MovRR () (Temp -> AbsReg
toAbsReg Temp
r) AbsReg
QuotRes ]
    }
evalE (IR.ExprIntBinOp IntBinOp
IR.WordDivIR Exp
e0 Exp
e1) Temp
r = do
    { Temp
r0 <- WriteM Temp
allocTemp64
    ; Temp
r1 <- WriteM Temp
allocTemp64
    ; [X86 AbsReg ()]
placeE <- Exp -> Temp -> WriteM [X86 AbsReg ()]
evalE Exp
e0 Temp
r0
    ; [X86 AbsReg ()]
placeE' <- Exp -> Temp -> WriteM [X86 AbsReg ()]
evalE Exp
e1 Temp
r1
    ; [X86 AbsReg ()] -> WriteM [X86 AbsReg ()]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([X86 AbsReg ()] -> WriteM [X86 AbsReg ()])
-> [X86 AbsReg ()] -> WriteM [X86 AbsReg ()]
forall a b. (a -> b) -> a -> b
$ [X86 AbsReg ()]
placeE [X86 AbsReg ()] -> [X86 AbsReg ()] -> [X86 AbsReg ()]
forall a. [a] -> [a] -> [a]
++ [X86 AbsReg ()]
placeE' [X86 AbsReg ()] -> [X86 AbsReg ()] -> [X86 AbsReg ()]
forall a. [a] -> [a] -> [a]
++ [ () -> AbsReg -> AbsReg -> X86 AbsReg ()
forall reg a. a -> reg -> reg -> X86 reg a
MovRR () AbsReg
QuotRes (Temp -> AbsReg
toAbsReg Temp
r0), () -> AbsReg -> AbsReg -> X86 AbsReg ()
forall reg a. a -> reg -> reg -> X86 reg a
XorRR () AbsReg
RemRes AbsReg
RemRes, () -> AbsReg -> X86 AbsReg ()
forall reg a. a -> reg -> X86 reg a
DivR () (Temp -> AbsReg
toAbsReg Temp
r1), () -> AbsReg -> AbsReg -> X86 AbsReg ()
forall reg a. a -> reg -> reg -> X86 reg a
MovRR () (Temp -> AbsReg
toAbsReg Temp
r) AbsReg
QuotRes ]
    }
evalE (IR.ExprIntBinOp IntBinOp
IR.WordModIR Exp
e0 Exp
e1) Temp
r = do
    { Temp
r0 <- WriteM Temp
allocTemp64
    ; Temp
r1 <- WriteM Temp
allocTemp64
    ; [X86 AbsReg ()]
placeE <- Exp -> Temp -> WriteM [X86 AbsReg ()]
evalE Exp
e0 Temp
r0
    ; [X86 AbsReg ()]
placeE' <- Exp -> Temp -> WriteM [X86 AbsReg ()]
evalE Exp
e1 Temp
r1
    ; [X86 AbsReg ()] -> WriteM [X86 AbsReg ()]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([X86 AbsReg ()] -> WriteM [X86 AbsReg ()])
-> [X86 AbsReg ()] -> WriteM [X86 AbsReg ()]
forall a b. (a -> b) -> a -> b
$ [X86 AbsReg ()]
placeE [X86 AbsReg ()] -> [X86 AbsReg ()] -> [X86 AbsReg ()]
forall a. [a] -> [a] -> [a]
++ [X86 AbsReg ()]
placeE' [X86 AbsReg ()] -> [X86 AbsReg ()] -> [X86 AbsReg ()]
forall a. [a] -> [a] -> [a]
++ [ () -> AbsReg -> AbsReg -> X86 AbsReg ()
forall reg a. a -> reg -> reg -> X86 reg a
MovRR () AbsReg
QuotRes (Temp -> AbsReg
toAbsReg Temp
r0), () -> AbsReg -> AbsReg -> X86 AbsReg ()
forall reg a. a -> reg -> reg -> X86 reg a
XorRR () AbsReg
RemRes AbsReg
RemRes, () -> AbsReg -> X86 AbsReg ()
forall reg a. a -> reg -> X86 reg a
DivR () (Temp -> AbsReg
toAbsReg Temp
r1), () -> AbsReg -> AbsReg -> X86 AbsReg ()
forall reg a. a -> reg -> reg -> X86 reg a
MovRR () (Temp -> AbsReg
toAbsReg Temp
r) AbsReg
RemRes ]
    }
evalE (IR.BoolBinOp BoolBinOp
IR.BoolAnd Exp
e0 Exp
e1) Temp
r = do
    { Temp
r0 <- WriteM Temp
allocTemp8
    ; Temp
r1 <- WriteM Temp
allocTemp8
    ; [X86 AbsReg ()]
placeE <- Exp -> Temp -> WriteM [X86 AbsReg ()]
evalE Exp
e0 Temp
r0
    ; [X86 AbsReg ()]
placeE' <- Exp -> Temp -> WriteM [X86 AbsReg ()]
evalE Exp
e1 Temp
r1
    ; [X86 AbsReg ()] -> WriteM [X86 AbsReg ()]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([X86 AbsReg ()] -> WriteM [X86 AbsReg ()])
-> [X86 AbsReg ()] -> WriteM [X86 AbsReg ()]
forall a b. (a -> b) -> a -> b
$ [X86 AbsReg ()]
placeE [X86 AbsReg ()] -> [X86 AbsReg ()] -> [X86 AbsReg ()]
forall a. [a] -> [a] -> [a]
++ [X86 AbsReg ()]
placeE' [X86 AbsReg ()] -> [X86 AbsReg ()] -> [X86 AbsReg ()]
forall a. [a] -> [a] -> [a]
++ [ () -> AbsReg -> AbsReg -> X86 AbsReg ()
forall reg a. a -> reg -> reg -> X86 reg a
MovRR () (Temp -> AbsReg
toAbsReg Temp
r) (Temp -> AbsReg
toAbsReg Temp
r0), () -> AbsReg -> AbsReg -> X86 AbsReg ()
forall reg a. a -> reg -> reg -> X86 reg a
AndRR () (Temp -> AbsReg
toAbsReg Temp
r) (Temp -> AbsReg
toAbsReg Temp
r1) ]
    }
evalE (IR.BoolBinOp BoolBinOp
IR.BoolOr Exp
e0 Exp
e1) Temp
r = do
    { Temp
r0 <- WriteM Temp
allocTemp8
    ; Temp
r1 <- WriteM Temp
allocTemp8
    ; [X86 AbsReg ()]
placeE <- Exp -> Temp -> WriteM [X86 AbsReg ()]
evalE Exp
e0 Temp
r0
    ; [X86 AbsReg ()]
placeE' <- Exp -> Temp -> WriteM [X86 AbsReg ()]
evalE Exp
e1 Temp
r1
    ; [X86 AbsReg ()] -> WriteM [X86 AbsReg ()]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([X86 AbsReg ()] -> WriteM [X86 AbsReg ()])
-> [X86 AbsReg ()] -> WriteM [X86 AbsReg ()]
forall a b. (a -> b) -> a -> b
$ [X86 AbsReg ()]
placeE [X86 AbsReg ()] -> [X86 AbsReg ()] -> [X86 AbsReg ()]
forall a. [a] -> [a] -> [a]
++ [X86 AbsReg ()]
placeE' [X86 AbsReg ()] -> [X86 AbsReg ()] -> [X86 AbsReg ()]
forall a. [a] -> [a] -> [a]
++ [ () -> AbsReg -> AbsReg -> X86 AbsReg ()
forall reg a. a -> reg -> reg -> X86 reg a
MovRR () (Temp -> AbsReg
toAbsReg Temp
r) (Temp -> AbsReg
toAbsReg Temp
r0), () -> AbsReg -> AbsReg -> X86 AbsReg ()
forall reg a. a -> reg -> reg -> X86 reg a
OrRR () (Temp -> AbsReg
toAbsReg Temp
r) (Temp -> AbsReg
toAbsReg Temp
r1) ]
    }
evalE (IR.BoolBinOp BoolBinOp
IR.BoolXor Exp
e0 Exp
e1) Temp
r = do
    { Temp
r0 <- WriteM Temp
allocTemp8
    ; Temp
r1 <- WriteM Temp
allocTemp8
    ; [X86 AbsReg ()]
placeE <- Exp -> Temp -> WriteM [X86 AbsReg ()]
evalE Exp
e0 Temp
r0
    ; [X86 AbsReg ()]
placeE' <- Exp -> Temp -> WriteM [X86 AbsReg ()]
evalE Exp
e1 Temp
r1
    ; [X86 AbsReg ()] -> WriteM [X86 AbsReg ()]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([X86 AbsReg ()] -> WriteM [X86 AbsReg ()])
-> [X86 AbsReg ()] -> WriteM [X86 AbsReg ()]
forall a b. (a -> b) -> a -> b
$ [X86 AbsReg ()]
placeE [X86 AbsReg ()] -> [X86 AbsReg ()] -> [X86 AbsReg ()]
forall a. [a] -> [a] -> [a]
++ [X86 AbsReg ()]
placeE' [X86 AbsReg ()] -> [X86 AbsReg ()] -> [X86 AbsReg ()]
forall a. [a] -> [a] -> [a]
++ [ () -> AbsReg -> AbsReg -> X86 AbsReg ()
forall reg a. a -> reg -> reg -> X86 reg a
MovRR () (Temp -> AbsReg
toAbsReg Temp
r) (Temp -> AbsReg
toAbsReg Temp
r0), () -> AbsReg -> AbsReg -> X86 AbsReg ()
forall reg a. a -> reg -> reg -> X86 reg a
XorRR () (Temp -> AbsReg
toAbsReg Temp
r) (Temp -> AbsReg
toAbsReg Temp
r1) ]
    }
evalE (IR.ExprIntBinOp IntBinOp
IR.IntMinusIR Exp
e0 Exp
e1) Temp
r = do
    { Temp
r0 <- WriteM Temp
allocTemp64
    ; Temp
r1 <- WriteM Temp
allocTemp64
    ; [X86 AbsReg ()]
placeE <- Exp -> Temp -> WriteM [X86 AbsReg ()]
evalE Exp
e0 Temp
r0
    ; [X86 AbsReg ()]
placeE' <- Exp -> Temp -> WriteM [X86 AbsReg ()]
evalE Exp
e1 Temp
r1
    ; [X86 AbsReg ()] -> WriteM [X86 AbsReg ()]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([X86 AbsReg ()] -> WriteM [X86 AbsReg ()])
-> [X86 AbsReg ()] -> WriteM [X86 AbsReg ()]
forall a b. (a -> b) -> a -> b
$ [X86 AbsReg ()]
placeE [X86 AbsReg ()] -> [X86 AbsReg ()] -> [X86 AbsReg ()]
forall a. [a] -> [a] -> [a]
++ [X86 AbsReg ()]
placeE' [X86 AbsReg ()] -> [X86 AbsReg ()] -> [X86 AbsReg ()]
forall a. [a] -> [a] -> [a]
++ [ () -> AbsReg -> AbsReg -> X86 AbsReg ()
forall reg a. a -> reg -> reg -> X86 reg a
MovRR () (Temp -> AbsReg
toAbsReg Temp
r) (Temp -> AbsReg
toAbsReg Temp
r0), () -> AbsReg -> AbsReg -> X86 AbsReg ()
forall reg a. a -> reg -> reg -> X86 reg a
SubRR () (Temp -> AbsReg
toAbsReg Temp
r) (Temp -> AbsReg
toAbsReg Temp
r1) ]
    }
evalE (IR.ExprIntBinOp IntBinOp
IR.IntPlusIR Exp
e0 Exp
e1) Temp
r = do
    { Temp
r0 <- WriteM Temp
allocTemp64
    ; Temp
r1 <- WriteM Temp
allocTemp64
    ; [X86 AbsReg ()]
placeE <- Exp -> Temp -> WriteM [X86 AbsReg ()]
evalE Exp
e0 Temp
r0
    ; [X86 AbsReg ()]
placeE' <- Exp -> Temp -> WriteM [X86 AbsReg ()]
evalE Exp
e1 Temp
r1
    ; [X86 AbsReg ()] -> WriteM [X86 AbsReg ()]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([X86 AbsReg ()] -> WriteM [X86 AbsReg ()])
-> [X86 AbsReg ()] -> WriteM [X86 AbsReg ()]
forall a b. (a -> b) -> a -> b
$ [X86 AbsReg ()]
placeE [X86 AbsReg ()] -> [X86 AbsReg ()] -> [X86 AbsReg ()]
forall a. [a] -> [a] -> [a]
++ [X86 AbsReg ()]
placeE' [X86 AbsReg ()] -> [X86 AbsReg ()] -> [X86 AbsReg ()]
forall a. [a] -> [a] -> [a]
++ [ () -> AbsReg -> AbsReg -> X86 AbsReg ()
forall reg a. a -> reg -> reg -> X86 reg a
MovRR () (Temp -> AbsReg
toAbsReg Temp
r) (Temp -> AbsReg
toAbsReg Temp
r0), () -> AbsReg -> AbsReg -> X86 AbsReg ()
forall reg a. a -> reg -> reg -> X86 reg a
AddRR () (Temp -> AbsReg
toAbsReg Temp
r) (Temp -> AbsReg
toAbsReg Temp
r1) ]
    }
evalE (IR.ExprIntBinOp IntBinOp
IR.IntTimesIR Exp
e0 Exp
e1) Temp
r = do
    { Temp
r0 <- WriteM Temp
allocTemp64
    ; Temp
r1 <- WriteM Temp
allocTemp64
    ; [X86 AbsReg ()]
placeE <- Exp -> Temp -> WriteM [X86 AbsReg ()]
evalE Exp
e0 Temp
r0
    ; [X86 AbsReg ()]
placeE' <- Exp -> Temp -> WriteM [X86 AbsReg ()]
evalE Exp
e1 Temp
r1
    ; [X86 AbsReg ()] -> WriteM [X86 AbsReg ()]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([X86 AbsReg ()] -> WriteM [X86 AbsReg ()])
-> [X86 AbsReg ()] -> WriteM [X86 AbsReg ()]
forall a b. (a -> b) -> a -> b
$ [X86 AbsReg ()]
placeE [X86 AbsReg ()] -> [X86 AbsReg ()] -> [X86 AbsReg ()]
forall a. [a] -> [a] -> [a]
++ [X86 AbsReg ()]
placeE' [X86 AbsReg ()] -> [X86 AbsReg ()] -> [X86 AbsReg ()]
forall a. [a] -> [a] -> [a]
++ [ () -> AbsReg -> AbsReg -> X86 AbsReg ()
forall reg a. a -> reg -> reg -> X86 reg a
MovRR () (Temp -> AbsReg
toAbsReg Temp
r) (Temp -> AbsReg
toAbsReg Temp
r0), () -> AbsReg -> AbsReg -> X86 AbsReg ()
forall reg a. a -> reg -> reg -> X86 reg a
ImulRR () (Temp -> AbsReg
toAbsReg Temp
r) (Temp -> AbsReg
toAbsReg Temp
r1) ]
    }
evalE (IR.ExprIntBinOp IntBinOp
IR.IntXorIR Exp
e0 Exp
e1) Temp
r = do
    { Temp
r0 <- WriteM Temp
allocTemp64
    ; Temp
r1 <- WriteM Temp
allocTemp64
    ; [X86 AbsReg ()]
placeE <- Exp -> Temp -> WriteM [X86 AbsReg ()]
evalE Exp
e0 Temp
r0
    ; [X86 AbsReg ()]
placeE' <- Exp -> Temp -> WriteM [X86 AbsReg ()]
evalE Exp
e1 Temp
r1
    ; [X86 AbsReg ()] -> WriteM [X86 AbsReg ()]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([X86 AbsReg ()] -> WriteM [X86 AbsReg ()])
-> [X86 AbsReg ()] -> WriteM [X86 AbsReg ()]
forall a b. (a -> b) -> a -> b
$ [X86 AbsReg ()]
placeE [X86 AbsReg ()] -> [X86 AbsReg ()] -> [X86 AbsReg ()]
forall a. [a] -> [a] -> [a]
++ [X86 AbsReg ()]
placeE' [X86 AbsReg ()] -> [X86 AbsReg ()] -> [X86 AbsReg ()]
forall a. [a] -> [a] -> [a]
++ [ () -> AbsReg -> AbsReg -> X86 AbsReg ()
forall reg a. a -> reg -> reg -> X86 reg a
MovRR () (Temp -> AbsReg
toAbsReg Temp
r) (Temp -> AbsReg
toAbsReg Temp
r0), () -> AbsReg -> AbsReg -> X86 AbsReg ()
forall reg a. a -> reg -> reg -> X86 reg a
XorRR () (Temp -> AbsReg
toAbsReg Temp
r) (Temp -> AbsReg
toAbsReg Temp
r1) ]
    }
evalE (IR.PopcountIR Exp
e0) Temp
r = do
    { Temp
r' <- WriteM Temp
allocTemp64
    ; [X86 AbsReg ()]
placeE <- Exp -> Temp -> WriteM [X86 AbsReg ()]
evalE Exp
e0 Temp
r'
    ; [X86 AbsReg ()] -> WriteM [X86 AbsReg ()]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([X86 AbsReg ()] -> WriteM [X86 AbsReg ()])
-> [X86 AbsReg ()] -> WriteM [X86 AbsReg ()]
forall a b. (a -> b) -> a -> b
$ [X86 AbsReg ()]
placeE [X86 AbsReg ()] -> [X86 AbsReg ()] -> [X86 AbsReg ()]
forall a. [a] -> [a] -> [a]
++ [ () -> AbsReg -> AbsReg -> X86 AbsReg ()
forall reg a. a -> reg -> reg -> X86 reg a
PopcountRR () (Temp -> AbsReg
toAbsReg Temp
r) (Temp -> AbsReg
toAbsReg Temp
r') ]
    }
evalE (IR.IntNegIR Exp
e) Temp
r = do
    { [X86 AbsReg ()]
placeE <- Exp -> Temp -> WriteM [X86 AbsReg ()]
evalE Exp
e Temp
r
    ; [X86 AbsReg ()] -> WriteM [X86 AbsReg ()]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([X86 AbsReg ()] -> WriteM [X86 AbsReg ()])
-> [X86 AbsReg ()] -> WriteM [X86 AbsReg ()]
forall a b. (a -> b) -> a -> b
$ [X86 AbsReg ()]
placeE [X86 AbsReg ()] -> [X86 AbsReg ()] -> [X86 AbsReg ()]
forall a. [a] -> [a] -> [a]
++ [ () -> AbsReg -> X86 AbsReg ()
forall reg a. a -> reg -> X86 reg a
NegR () (Temp -> AbsReg
toAbsReg Temp
r) ]
    }

toByte :: Bool -> Word8
toByte :: Bool -> Word8
toByte Bool
False = Word8
0
toByte Bool
True  = Word8
1

-- I wonder if I could use a hylo.?