module Nes.CPU.Instructions.Bitwise (
    -- * Test bit
    bit,

    -- * Bit logic
    and,
    ora,
    eor,

    -- * Rotate
    rol,
    ror,
    rla,
    asl,
    lsr,

    -- * Unofficial
    anc,
    sre,
    slo,
    alr,
    arr,
    xaa,

    -- * Internal
    rol_,
    ror_,
) where

import Control.Monad
import Data.Bits hiding (bit, rotate)
import Nes.CPU.Instructions.Addressing
import Nes.CPU.Instructions.After
import Nes.CPU.Monad
import Nes.CPU.State
import Nes.FlagRegister
import Nes.Internal.MonadState
import Nes.Memory
import Prelude hiding (and)

-- |  test if one or more bits are set in a target memory location
--
-- https://www.nesdev.org/obelisk-6502-guide/reference.html#BIT
bit :: AddressingMode -> CPU r ()
bit :: forall r. AddressingMode -> CPU r ()
bit AddressingMode
mode = do
    Byte
value <- AddressingMode -> CPU r Addr
forall r. AddressingMode -> CPU r Addr
getOperandAddr AddressingMode
mode CPU r Addr -> (Addr -> CPU r Byte) -> CPU r Byte
forall a b. CPU r a -> (a -> CPU r b) -> CPU r b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Addr -> () -> CPU r Byte
forall a (m :: * -> *). MemoryInterface a m => Addr -> a -> m Byte
`readByte` ())
    Byte
regA <- Getting Byte CPUState Byte -> CPU r Byte
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting Byte CPUState Byte
Lens' CPUState Byte
registerA
    let res :: Byte
res = Byte
regA Byte -> Byte -> Byte
forall a. Bits a => a -> a -> a
.&. Byte
value
    (StatusRegister -> Identity StatusRegister)
-> CPUState -> Identity CPUState
Lens' CPUState StatusRegister
status
        ((StatusRegister -> Identity StatusRegister)
 -> CPUState -> Identity CPUState)
-> (StatusRegister -> StatusRegister) -> CPU r ()
forall s (m :: * -> *) a.
MonadState s m =>
ASetter' s a -> (a -> a) -> m ()
%= ( Flag StatusRegister -> Bool -> StatusRegister -> StatusRegister
forall a. FlagRegister a => Flag a -> Bool -> a -> a
setFlag' Flag StatusRegister
StatusRegisterFlag
Zero (Byte
res Byte -> Byte -> Bool
forall a. Eq a => a -> a -> Bool
== Byte
0)
                (StatusRegister -> StatusRegister)
-> (StatusRegister -> StatusRegister)
-> StatusRegister
-> StatusRegister
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Flag StatusRegister -> Bool -> StatusRegister -> StatusRegister
forall a. FlagRegister a => Flag a -> Bool -> a -> a
setFlag' Flag StatusRegister
StatusRegisterFlag
Overflow (Byte -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit Byte
value Int
6)
                (StatusRegister -> StatusRegister)
-> (StatusRegister -> StatusRegister)
-> StatusRegister
-> StatusRegister
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Flag StatusRegister -> Bool -> StatusRegister -> StatusRegister
forall a. FlagRegister a => Flag a -> Bool -> a -> a
setFlag' Flag StatusRegister
StatusRegisterFlag
Negative (Byte -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit Byte
value Int
7)
           )

-- | Register A = Register A & _value in memory_
--
-- https://www.nesdev.org/obelisk-6502-guide/reference.html#AND
and :: AddressingMode -> CPU r ()
and :: forall r. AddressingMode -> CPU r ()
and = (Byte -> Byte -> Byte) -> AddressingMode -> CPU r ()
forall r. (Byte -> Byte -> Byte) -> AddressingMode -> CPU r ()
applyLogicOnRegisterA Byte -> Byte -> Byte
forall a. Bits a => a -> a -> a
(.&.)

-- | Register A = Register A | _value in memory_
--
-- https://www.nesdev.org/obelisk-6502-guide/reference.html#ORA
ora :: AddressingMode -> CPU r ()
ora :: forall r. AddressingMode -> CPU r ()
ora = (Byte -> Byte -> Byte) -> AddressingMode -> CPU r ()
forall r. (Byte -> Byte -> Byte) -> AddressingMode -> CPU r ()
applyLogicOnRegisterA Byte -> Byte -> Byte
forall a. Bits a => a -> a -> a
(.|.)

-- | Register A = Register A ^ _value in memory_
--
-- https://www.nesdev.org/obelisk-6502-guide/reference.html#EOR
eor :: AddressingMode -> CPU r ()
eor :: forall r. AddressingMode -> CPU r ()
eor = (Byte -> Byte -> Byte) -> AddressingMode -> CPU r ()
forall r. (Byte -> Byte -> Byte) -> AddressingMode -> CPU r ()
applyLogicOnRegisterA Byte -> Byte -> Byte
forall a. Bits a => a -> a -> a
(.^.)

{-# INLINE applyLogicOnRegisterA #-}
applyLogicOnRegisterA :: (Byte -> Byte -> Byte) -> AddressingMode -> CPU r ()
applyLogicOnRegisterA :: forall r. (Byte -> Byte -> Byte) -> AddressingMode -> CPU r ()
applyLogicOnRegisterA Byte -> Byte -> Byte
op AddressingMode
mode = do
    Byte
value <- AddressingMode -> CPU r Addr
forall r. AddressingMode -> CPU r Addr
getOperandAddr AddressingMode
mode CPU r Addr -> (Addr -> CPU r Byte) -> CPU r Byte
forall a b. CPU r a -> (a -> CPU r b) -> CPU r b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Addr -> () -> CPU r Byte
forall a (m :: * -> *). MemoryInterface a m => Addr -> a -> m Byte
`readByte` ())
    CPU r Byte -> CPU r ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (CPU r Byte -> CPU r ()) -> CPU r Byte -> CPU r ()
forall a b. (a -> b) -> a -> b
$ (Byte -> Byte) -> CPU r Byte
forall r. (Byte -> Byte) -> CPU r Byte
modifyRegisterA (Byte -> Byte -> Byte
`op` Byte
value)

-- | Rotate left
--
-- https://www.nesdev.org/obelisk-6502-guide/reference.html#ROL
rol :: AddressingMode -> CPU r ()
rol :: forall r. AddressingMode -> CPU r ()
rol AddressingMode
mode = do
    Byte
_ <- AddressingMode -> CPU r Byte
forall r. AddressingMode -> CPU r Byte
rol_ AddressingMode
mode
    Bool -> CPU r () -> CPU r ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (AddressingMode
mode AddressingMode -> AddressingMode -> Bool
forall a. Eq a => a -> a -> Bool
== AddressingMode
AbsoluteX) CPU r ()
forall r. CPU r ()
tickOnce

{-# INLINE rol_ #-}
rol_ :: AddressingMode -> CPU r Byte
rol_ :: forall r. AddressingMode -> CPU r Byte
rol_ =
    (Byte -> Bool -> Byte)
-> (Byte -> CPU r ()) -> AddressingMode -> CPU r Byte
forall r.
(Byte -> Bool -> Byte)
-> (Byte -> CPU r ()) -> AddressingMode -> CPU r Byte
rotate
        ( \Byte
value Bool
carry ->
            let shifted :: Byte
shifted = Byte -> Int -> Byte
forall a. Bits a => a -> Int -> a
shiftL Byte
value Int
1
             in if Bool
carry then Byte -> Int -> Byte
forall a. Bits a => a -> Int -> a
setBit Byte
shifted Int
0 else Byte
shifted
        )
        (\Byte
byte -> (StatusRegister -> Identity StatusRegister)
-> CPUState -> Identity CPUState
Lens' CPUState StatusRegister
status ((StatusRegister -> Identity StatusRegister)
 -> CPUState -> Identity CPUState)
-> (StatusRegister -> StatusRegister) -> CPU r ()
forall s (m :: * -> *) a.
MonadState s m =>
ASetter' s a -> (a -> a) -> m ()
%= Flag StatusRegister -> Bool -> StatusRegister -> StatusRegister
forall a. FlagRegister a => Flag a -> Bool -> a -> a
setFlag' Flag StatusRegister
StatusRegisterFlag
Carry (Byte -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit Byte
byte Int
7))

-- | Rotate right
--
-- https://www.nesdev.org/obelisk-6502-guide/reference.html#ROR
ror :: AddressingMode -> CPU r ()
ror :: forall r. AddressingMode -> CPU r ()
ror AddressingMode
mode = do
    Byte
_ <- AddressingMode -> CPU r Byte
forall r. AddressingMode -> CPU r Byte
ror_ AddressingMode
mode
    Bool -> CPU r () -> CPU r ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (AddressingMode
mode AddressingMode -> AddressingMode -> Bool
forall a. Eq a => a -> a -> Bool
== AddressingMode
AbsoluteX) CPU r ()
forall r. CPU r ()
tickOnce

{-# INLINE ror_ #-}
ror_ :: AddressingMode -> CPU r Byte
ror_ :: forall r. AddressingMode -> CPU r Byte
ror_ =
    (Byte -> Bool -> Byte)
-> (Byte -> CPU r ()) -> AddressingMode -> CPU r Byte
forall r.
(Byte -> Bool -> Byte)
-> (Byte -> CPU r ()) -> AddressingMode -> CPU r Byte
rotate
        ( \Byte
value Bool
carry ->
            let shifted :: Byte
shifted = Byte -> Int -> Byte
forall a. Bits a => a -> Int -> a
shiftR Byte
value Int
1
             in if Bool
carry then Byte -> Int -> Byte
forall a. Bits a => a -> Int -> a
setBit Byte
shifted Int
7 else Byte
shifted
        )
        (\Byte
byte -> (StatusRegister -> Identity StatusRegister)
-> CPUState -> Identity CPUState
Lens' CPUState StatusRegister
status ((StatusRegister -> Identity StatusRegister)
 -> CPUState -> Identity CPUState)
-> (StatusRegister -> StatusRegister) -> CPU r ()
forall s (m :: * -> *) a.
MonadState s m =>
ASetter' s a -> (a -> a) -> m ()
%= Flag StatusRegister -> Bool -> StatusRegister -> StatusRegister
forall a. FlagRegister a => Flag a -> Bool -> a -> a
setFlag' Flag StatusRegister
StatusRegisterFlag
Carry (Byte -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit Byte
byte Int
0))

rotate :: (Byte -> Bool -> Byte) -> (Byte -> CPU r ()) -> AddressingMode -> CPU r Byte
rotate :: forall r.
(Byte -> Bool -> Byte)
-> (Byte -> CPU r ()) -> AddressingMode -> CPU r Byte
rotate Byte -> Bool -> Byte
f Byte -> CPU r ()
setCarry AddressingMode
mode =
    AddressingMode -> (Byte -> CPU r Byte) -> CPU r Byte
forall r. AddressingMode -> (Byte -> CPU r Byte) -> CPU r Byte
withOperand
        AddressingMode
mode
        ( \Byte
value -> do
            Byte
res <- Byte -> Bool -> Byte
f Byte
value (Bool -> Byte) -> CPU r Bool -> CPU r Byte
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Getting StatusRegister CPUState StatusRegister
-> (StatusRegister -> Bool) -> CPU r Bool
forall s (m :: * -> *) a r.
MonadState s m =>
Getting a s a -> (a -> r) -> m r
uses Getting StatusRegister CPUState StatusRegister
Lens' CPUState StatusRegister
status (Flag StatusRegister -> StatusRegister -> Bool
forall a. FlagRegister a => Flag a -> a -> Bool
getFlag Flag StatusRegister
StatusRegisterFlag
Carry)
            Byte -> CPU r ()
forall r. Byte -> CPU r ()
setZeroAndNegativeFlags Byte
res
            Byte -> CPU r ()
setCarry Byte
value
            Byte -> CPU r Byte
forall a. a -> CPU r a
forall (m :: * -> *) a. Monad m => a -> m a
return Byte
res
        )

rla :: AddressingMode -> CPU r ()
rla :: forall r. AddressingMode -> CPU r ()
rla AddressingMode
mode = do
    Byte
value <- AddressingMode -> CPU r Byte
forall r. AddressingMode -> CPU r Byte
rol_ AddressingMode
mode
    CPU r Byte -> CPU r ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (CPU r Byte -> CPU r ()) -> CPU r Byte -> CPU r ()
forall a b. (a -> b) -> a -> b
$ (Byte -> Byte) -> CPU r Byte
forall r. (Byte -> Byte) -> CPU r Byte
modifyRegisterA (Byte
value Byte -> Byte -> Byte
forall a. Bits a => a -> a -> a
.&.)

anc :: AddressingMode -> CPU r ()
anc :: forall r. AddressingMode -> CPU r ()
anc =
    AddressingMode -> CPU r ()
forall r. AddressingMode -> CPU r ()
and (AddressingMode -> CPU r ())
-> (() -> CPU r ()) -> AddressingMode -> CPU r ()
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> \() -> do
        Bool
isNeg <- Getting StatusRegister CPUState StatusRegister
-> (StatusRegister -> Bool) -> CPU r Bool
forall s (m :: * -> *) a r.
MonadState s m =>
Getting a s a -> (a -> r) -> m r
uses Getting StatusRegister CPUState StatusRegister
Lens' CPUState StatusRegister
status ((StatusRegister -> Bool) -> CPU r Bool)
-> (StatusRegister -> Bool) -> CPU r Bool
forall a b. (a -> b) -> a -> b
$ Flag StatusRegister -> StatusRegister -> Bool
forall a. FlagRegister a => Flag a -> a -> Bool
getFlag Flag StatusRegister
StatusRegisterFlag
Negative
        (StatusRegister -> Identity StatusRegister)
-> CPUState -> Identity CPUState
Lens' CPUState StatusRegister
status ((StatusRegister -> Identity StatusRegister)
 -> CPUState -> Identity CPUState)
-> (StatusRegister -> StatusRegister) -> CPU r ()
forall s (m :: * -> *) a.
MonadState s m =>
ASetter' s a -> (a -> a) -> m ()
%= Flag StatusRegister -> Bool -> StatusRegister -> StatusRegister
forall a. FlagRegister a => Flag a -> Bool -> a -> a
setFlag' Flag StatusRegister
StatusRegisterFlag
Carry Bool
isNeg

-- | Arithmetic Shift Left
--
-- https://www.nesdev.org/obelisk-6502-guide/reference.html#ASL
asl :: AddressingMode -> CPU r ()
asl :: forall r. AddressingMode -> CPU r ()
asl AddressingMode
mode = AddressingMode -> CPU r Byte
forall r. AddressingMode -> CPU r Byte
asl_ AddressingMode
mode CPU r Byte -> CPU r () -> CPU r ()
forall a b. CPU r a -> CPU r b -> CPU r b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> CPU r () -> CPU r ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (AddressingMode
mode AddressingMode -> AddressingMode -> Bool
forall a. Eq a => a -> a -> Bool
== AddressingMode
AbsoluteX) CPU r ()
forall r. CPU r ()
tickOnce

{-# INLINE asl_ #-}
asl_ :: AddressingMode -> CPU r Byte
asl_ :: forall r. AddressingMode -> CPU r Byte
asl_ AddressingMode
mode = AddressingMode -> (Byte -> CPU r Byte) -> CPU r Byte
forall r. AddressingMode -> (Byte -> CPU r Byte) -> CPU r Byte
withOperand AddressingMode
mode ((Byte -> CPU r Byte) -> CPU r Byte)
-> (Byte -> CPU r Byte) -> CPU r Byte
forall a b. (a -> b) -> a -> b
$ \Byte
value -> do
    let carry :: Bool
carry = Byte -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit Byte
value Int
7
        res :: Byte
res = Byte -> Int -> Byte
forall a. Bits a => a -> Int -> a
shiftL Byte
value Int
1
    (StatusRegister -> Identity StatusRegister)
-> CPUState -> Identity CPUState
Lens' CPUState StatusRegister
status ((StatusRegister -> Identity StatusRegister)
 -> CPUState -> Identity CPUState)
-> (StatusRegister -> StatusRegister) -> CPU r ()
forall s (m :: * -> *) a.
MonadState s m =>
ASetter' s a -> (a -> a) -> m ()
%= Flag StatusRegister -> Bool -> StatusRegister -> StatusRegister
forall a. FlagRegister a => Flag a -> Bool -> a -> a
setFlag' Flag StatusRegister
StatusRegisterFlag
Carry Bool
carry
    Byte -> CPU r ()
forall r. Byte -> CPU r ()
setZeroAndNegativeFlags Byte
res
    Byte -> CPU r Byte
forall a. a -> CPU r a
forall (m :: * -> *) a. Monad m => a -> m a
return Byte
res

-- | Logical Shift Right
--
-- https://www.nesdev.org/obelisk-6502-guide/reference.html#LSR
lsr :: AddressingMode -> CPU r ()
lsr :: forall r. AddressingMode -> CPU r ()
lsr AddressingMode
mode = AddressingMode -> CPU r Byte
forall r. AddressingMode -> CPU r Byte
lsr_ AddressingMode
mode CPU r Byte -> CPU r () -> CPU r ()
forall a b. CPU r a -> CPU r b -> CPU r b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> CPU r () -> CPU r ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (AddressingMode
mode AddressingMode -> AddressingMode -> Bool
forall a. Eq a => a -> a -> Bool
== AddressingMode
AbsoluteX) CPU r ()
forall r. CPU r ()
tickOnce

{-# INLINE lsr_ #-}
lsr_ :: AddressingMode -> CPU r Byte
lsr_ :: forall r. AddressingMode -> CPU r Byte
lsr_ AddressingMode
mode =
    AddressingMode -> (Byte -> CPU r Byte) -> CPU r Byte
forall r. AddressingMode -> (Byte -> CPU r Byte) -> CPU r Byte
withOperand
        AddressingMode
mode
        ( \Byte
value -> do
            let carry :: Bool
carry = Byte -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit Byte
value Int
0
                res :: Byte
res = Byte -> Int -> Byte
forall a. Bits a => a -> Int -> a
shiftR Byte
value Int
1
            (StatusRegister -> Identity StatusRegister)
-> CPUState -> Identity CPUState
Lens' CPUState StatusRegister
status ((StatusRegister -> Identity StatusRegister)
 -> CPUState -> Identity CPUState)
-> (StatusRegister -> StatusRegister) -> CPU r ()
forall s (m :: * -> *) a.
MonadState s m =>
ASetter' s a -> (a -> a) -> m ()
%= Flag StatusRegister -> Bool -> StatusRegister -> StatusRegister
forall a. FlagRegister a => Flag a -> Bool -> a -> a
setFlag' Flag StatusRegister
StatusRegisterFlag
Carry Bool
carry
            Byte -> CPU r ()
forall r. Byte -> CPU r ()
setZeroAndNegativeFlags Byte
res
            Byte -> CPU r Byte
forall a. a -> CPU r a
forall (m :: * -> *) a. Monad m => a -> m a
return Byte
res
        )

-- | (Unofficial) Equivalent to LSR and XOR
sre :: AddressingMode -> CPU r ()
sre :: forall r. AddressingMode -> CPU r ()
sre AddressingMode
mode = do
    Byte
value <- AddressingMode -> CPU r Byte
forall r. AddressingMode -> CPU r Byte
lsr_ AddressingMode
mode
    CPU r Byte -> CPU r ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (CPU r Byte -> CPU r ()) -> CPU r Byte -> CPU r ()
forall a b. (a -> b) -> a -> b
$ (Byte -> Byte) -> CPU r Byte
forall r. (Byte -> Byte) -> CPU r Byte
modifyRegisterA (Byte -> Byte -> Byte
forall a. Bits a => a -> a -> a
.^. Byte
value)

-- | (Unofficial) Equivalent to ASL value then ORA value, except supporting more addressing modes
slo :: AddressingMode -> CPU r ()
slo :: forall r. AddressingMode -> CPU r ()
slo AddressingMode
mode = do
    Byte
value <- AddressingMode -> CPU r Byte
forall r. AddressingMode -> CPU r Byte
asl_ AddressingMode
mode
    CPU r Byte -> CPU r ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (CPU r Byte -> CPU r ()) -> CPU r Byte -> CPU r ()
forall a b. (a -> b) -> a -> b
$ (Byte -> Byte) -> CPU r Byte
forall r. (Byte -> Byte) -> CPU r Byte
modifyRegisterA (Byte
value Byte -> Byte -> Byte
forall a. Bits a => a -> a -> a
.|.)

-- | (Unofficial) AND + LSR
--
-- Source: https://github.com/bugzmanov/nes_ebook/blob/785b9ed8b803d9f4bd51274f4d0c68c14a1b3a8b/code/ch8/src/cpu.rs#L1073
alr :: AddressingMode -> CPU r ()
alr :: forall r. AddressingMode -> CPU r ()
alr AddressingMode
mode = AddressingMode -> CPU r ()
forall r. AddressingMode -> CPU r ()
and AddressingMode
mode CPU r () -> CPU r () -> CPU r ()
forall a b. CPU r a -> CPU r b -> CPU r b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> AddressingMode -> CPU r ()
forall r. AddressingMode -> CPU r ()
lsr AddressingMode
Accumulator

-- | (Unofficial) part of this command are some ADC mechanisms. following effects appear after AND but before ROR
--
-- Source: https://github.com/bugzmanov/nes_ebook/blob/785b9ed8b803d9f4bd51274f4d0c68c14a1b3a8b/code/ch8/src/cpu.rs#L1028
arr :: AddressingMode -> CPU r ()
arr :: forall r. AddressingMode -> CPU r ()
arr AddressingMode
mode = do
    Addr
addr <- AddressingMode -> CPU r Addr
forall r. AddressingMode -> CPU r Addr
getOperandAddr AddressingMode
mode
    Byte
byte <- Addr -> () -> CPU r Byte
forall a (m :: * -> *). MemoryInterface a m => Addr -> a -> m Byte
readByte Addr
addr ()
    CPU r Byte -> CPU r ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (CPU r Byte -> CPU r ()) -> CPU r Byte -> CPU r ()
forall a b. (a -> b) -> a -> b
$ (Byte -> Byte) -> CPU r Byte
forall r. (Byte -> Byte) -> CPU r Byte
modifyRegisterA (Byte -> Byte -> Byte
forall a. Bits a => a -> a -> a
.&. Byte
byte)
    AddressingMode -> CPU r ()
forall r. AddressingMode -> CPU r ()
ror AddressingMode
Accumulator
    Byte
res <- Getting Byte CPUState Byte -> CPU r Byte
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting Byte CPUState Byte
Lens' CPUState Byte
registerA
    (StatusRegister -> Identity StatusRegister)
-> CPUState -> Identity CPUState
Lens' CPUState StatusRegister
status
        ((StatusRegister -> Identity StatusRegister)
 -> CPUState -> Identity CPUState)
-> (StatusRegister -> StatusRegister) -> CPU r ()
forall s (m :: * -> *) a.
MonadState s m =>
ASetter' s a -> (a -> a) -> m ()
%= ( Flag StatusRegister -> Bool -> StatusRegister -> StatusRegister
forall a. FlagRegister a => Flag a -> Bool -> a -> a
setFlag' Flag StatusRegister
StatusRegisterFlag
Carry (Byte -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit Byte
res Int
6)
                (StatusRegister -> StatusRegister)
-> (StatusRegister -> StatusRegister)
-> StatusRegister
-> StatusRegister
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Flag StatusRegister -> Bool -> StatusRegister -> StatusRegister
forall a. FlagRegister a => Flag a -> Bool -> a -> a
setFlag' Flag StatusRegister
StatusRegisterFlag
Overflow (Byte -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit Byte
res Int
6 Bool -> Bool -> Bool
forall a. Bits a => a -> a -> a
`xor` Byte -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit Byte
res Int
5)
           )
    Byte -> CPU r ()
forall r. Byte -> CPU r ()
setZeroAndNegativeFlags Byte
res

-- | (Unofficial)
--
-- Source: https://github.com/bugzmanov/nes_ebook/blob/785b9ed8b803d9f4bd51274f4d0c68c14a1b3a8b/code/ch8/src/cpu.rs#L1133
xaa :: AddressingMode -> CPU r ()
xaa :: forall r. AddressingMode -> CPU r ()
xaa AddressingMode
mode = do
    Byte
x <- Getting Byte CPUState Byte -> CPU r Byte
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting Byte CPUState Byte
Lens' CPUState Byte
registerX
    (Byte -> Identity Byte) -> CPUState -> Identity CPUState
Lens' CPUState Byte
registerA ((Byte -> Identity Byte) -> CPUState -> Identity CPUState)
-> Byte -> CPU r ()
forall s (m :: * -> *) a.
MonadState s m =>
ASetter' s a -> a -> m ()
.= Byte
x
    Byte -> CPU r ()
forall r. Byte -> CPU r ()
setZeroAndNegativeFlags Byte
x
    Byte
byte <- AddressingMode -> CPU r Addr
forall r. AddressingMode -> CPU r Addr
getOperandAddr AddressingMode
mode CPU r Addr -> (Addr -> CPU r Byte) -> CPU r Byte
forall a b. CPU r a -> (a -> CPU r b) -> CPU r b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Addr -> () -> CPU r Byte
forall a (m :: * -> *). MemoryInterface a m => Addr -> a -> m Byte
`readByte` ())
    CPU r Byte -> CPU r ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (CPU r Byte -> CPU r ()) -> CPU r Byte -> CPU r ()
forall a b. (a -> b) -> a -> b
$ (Byte -> Byte) -> CPU r Byte
forall r. (Byte -> Byte) -> CPU r Byte
modifyRegisterA (Byte -> Byte -> Byte
forall a. Bits a => a -> a -> a
.&. Byte
byte)

{-# INLINE withOperand #-}
withOperand :: AddressingMode -> (Byte -> CPU r Byte) -> CPU r Byte
withOperand :: forall r. AddressingMode -> (Byte -> CPU r Byte) -> CPU r Byte
withOperand AddressingMode
Accumulator Byte -> CPU r Byte
f = do
    Byte
a <- Getting Byte CPUState Byte -> CPU r Byte
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting Byte CPUState Byte
Lens' CPUState Byte
registerA
    Byte
res <- Byte -> CPU r Byte
f Byte
a
    (Byte -> Identity Byte) -> CPUState -> Identity CPUState
Lens' CPUState Byte
registerA ((Byte -> Identity Byte) -> CPUState -> Identity CPUState)
-> Byte -> CPU r ()
forall s (m :: * -> *) a.
MonadState s m =>
ASetter' s a -> a -> m ()
.= Byte
res
    CPU r ()
forall r. CPU r ()
tickOnce
    Byte -> CPU r Byte
forall a. a -> CPU r a
forall (m :: * -> *) a. Monad m => a -> m a
return Byte
res
withOperand AddressingMode
mode Byte -> CPU r Byte
f = do
    Addr
addr <- AddressingMode -> CPU r Addr
forall r. AddressingMode -> CPU r Addr
getOperandAddr AddressingMode
mode
    Byte
value <- Addr -> () -> CPU r Byte
forall a (m :: * -> *). MemoryInterface a m => Addr -> a -> m Byte
readByte Addr
addr ()
    Byte
res <- Byte -> CPU r Byte
f Byte
value
    -- https://www.nesdev.org/wiki/Cycle_counting
    --  it takes 1 extra cycle to modify the value
    CPU r ()
forall r. CPU r ()
tickOnce
    Byte -> Addr -> () -> CPU r ()
forall a (m :: * -> *).
MemoryInterface a m =>
Byte -> Addr -> a -> m ()
writeByte Byte
res Addr
addr ()
    Byte -> CPU r Byte
forall a. a -> CPU r a
forall (m :: * -> *) a. Monad m => a -> m a
return Byte
res

{-# INLINE modifyRegisterA #-}
modifyRegisterA :: (Byte -> Byte) -> CPU r Byte
modifyRegisterA :: forall r. (Byte -> Byte) -> CPU r Byte
modifyRegisterA Byte -> Byte
f = do
    Byte
regA <- Getting Byte CPUState Byte -> CPU r Byte
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting Byte CPUState Byte
Lens' CPUState Byte
registerA
    let res :: Byte
res = Byte -> Byte
f Byte
regA
    Byte -> CPU r ()
forall r. Byte -> CPU r ()
setZeroAndNegativeFlags Byte
res
    (Byte -> Identity Byte) -> CPUState -> Identity CPUState
Lens' CPUState Byte
registerA ((Byte -> Identity Byte) -> CPUState -> Identity CPUState)
-> Byte -> CPU r ()
forall s (m :: * -> *) a.
MonadState s m =>
ASetter' s a -> a -> m ()
.= Byte
res
    Byte -> CPU r Byte
forall a. a -> CPU r a
forall (m :: * -> *) a. Monad m => a -> m a
return Byte
res