{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}

{-# HLINT ignore "Redundant bracket" #-}

-- | Unofficial instructions that are combinations of official ones
module Nes.CPU.Instructions.Unofficial (lax, sax, dcp, rra, sha, shx, shy, shs, lxa, axs) where

import Control.Monad
import Data.Bits
import Nes.CPU.Instructions.Access (lda)
import Nes.CPU.Instructions.Addressing
import Nes.CPU.Instructions.After (setZeroAndNegativeFlags)
import Nes.CPU.Instructions.Arith (addToRegisterA)
import Nes.CPU.Instructions.Bitwise (ror_)
import Nes.CPU.Instructions.Transfer
import Nes.CPU.Monad
import Nes.CPU.State
import Nes.FlagRegister
import Nes.Internal.MonadState
import Nes.Memory

-- Source: https://www.nesdev.org/wiki/Programming_with_unofficial_opcodes

-- | Equivalent to LDA then TAX, saves a couple of cycles
lax :: AddressingMode -> CPU r ()
lax :: forall r. AddressingMode -> CPU r ()
lax 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 ()
    Register -> Lens' CPUState Byte
register Register
A ((Byte -> Identity Byte) -> CPUState -> Identity CPUState)
-> Byte -> CPU r ()
forall s (m :: * -> *) a.
MonadState s m =>
ASetter' s a -> a -> m ()
.= Byte
byte
    Register -> Lens' CPUState Byte
register Register
X ((Byte -> Identity Byte) -> CPUState -> Identity CPUState)
-> Byte -> CPU r ()
forall s (m :: * -> *) a.
MonadState s m =>
ASetter' s a -> a -> m ()
.= Byte
byte
    Byte -> CPU r ()
forall r. Byte -> CPU r ()
setZeroAndNegativeFlags Byte
byte

-- | Stores the bitwise AND of A and X. No flags are affected
sax :: AddressingMode -> CPU r ()
sax :: forall r. AddressingMode -> CPU r ()
sax AddressingMode
mode = do
    Addr
dest <- AddressingMode -> CPU r Addr
forall r. AddressingMode -> CPU r Addr
getOperandAddr AddressingMode
mode
    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
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
    let res :: Byte
res = Byte
a Byte -> Byte -> Byte
forall a. Bits a => a -> a -> a
.&. Byte
x
    Byte -> Addr -> () -> CPU r ()
forall a (m :: * -> *).
MemoryInterface a m =>
Byte -> Addr -> a -> m ()
writeByte Byte
res Addr
dest ()

-- | Equivalent to DEC value then CMP value, except supporting more addressing modes
dcp :: AddressingMode -> CPU r ()
dcp :: forall r. AddressingMode -> CPU r ()
dcp AddressingMode
mode = do
    Addr
addr <- AddressingMode -> CPU r Addr
forall r. AddressingMode -> CPU r Addr
getOperandAddr AddressingMode
mode
    Byte
value <- (Byte -> Byte -> Byte
forall a. Num a => a -> a -> a
+ (-Byte
1)) (Byte -> Byte) -> CPU r Byte -> CPU r Byte
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Addr -> () -> CPU r Byte
forall a (m :: * -> *). MemoryInterface a m => Addr -> a -> m Byte
readByte Addr
addr ()
    Byte -> Addr -> () -> CPU r ()
forall a (m :: * -> *).
MemoryInterface a m =>
Byte -> Addr -> a -> m ()
writeByte Byte
value Addr
addr ()
    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
    CPU r ()
forall r. CPU r ()
tickOnce -- It's a Read-modify-write operation
    Bool -> CPU r () -> CPU r ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Byte
value Byte -> Byte -> Bool
forall a. Ord a => a -> a -> Bool
<= Byte
a) (CPU r () -> CPU r ()) -> CPU r () -> CPU r ()
forall a b. (a -> b) -> a -> b
$ (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 -> StatusRegister -> StatusRegister
forall a. FlagRegister a => Flag a -> a -> a
setFlag Flag StatusRegister
StatusRegisterFlag
Carry)
    Byte -> CPU r ()
forall r. Byte -> CPU r ()
setZeroAndNegativeFlags (Byte
a Byte -> Byte -> Byte
forall a. Num a => a -> a -> a
- Byte
value)

-- | (Unofficial) ROR and ADC
rra :: AddressingMode -> CPU r ()
rra :: forall r. AddressingMode -> CPU r ()
rra AddressingMode
mode = do
    Byte
value <- AddressingMode -> CPU r Byte
forall r. AddressingMode -> CPU r Byte
ror_ AddressingMode
mode
    Byte -> CPU r ()
forall r. Byte -> CPU r ()
addToRegisterA Byte
value

-- | Source: https://forums.nesdev.org/viewtopic.php?t=8107
shx :: AddressingMode -> CPU r ()
shx :: forall r. AddressingMode -> CPU r ()
shx 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
    Addr
operand <- Getting Addr CPUState Addr -> (Addr -> CPU r Addr) -> CPU r Addr
forall s (m :: * -> *) a r.
MonadState s m =>
Getting a s a -> (a -> m r) -> m r
usesM Getting Addr CPUState Addr
Lens' CPUState Addr
pc (Addr -> () -> CPU r Addr
forall a (m :: * -> *). MemoryInterface a m => Addr -> a -> m Addr
`readAddr` ())
    (Addr -> Addr)
-> (Byte -> Byte) -> (Byte -> Byte) -> AddressingMode -> CPU r ()
forall r.
(Addr -> Addr)
-> (Byte -> Byte) -> (Byte -> Byte) -> AddressingMode -> CPU r ()
sh' (Addr -> Addr -> Addr
forall a b. a -> b -> a
const Addr
operand) (Byte -> Byte -> Byte
forall a. Bits a => a -> a -> a
.&. Byte
x) (Byte -> Byte -> Byte
forall a. Bits a => a -> a -> a
.&. Byte
x) AddressingMode
mode

shy :: AddressingMode -> CPU r ()
shy :: forall r. AddressingMode -> CPU r ()
shy AddressingMode
mode = do
    Byte
y <- 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
registerY
    Addr
operand <- Getting Addr CPUState Addr -> (Addr -> CPU r Addr) -> CPU r Addr
forall s (m :: * -> *) a r.
MonadState s m =>
Getting a s a -> (a -> m r) -> m r
usesM Getting Addr CPUState Addr
Lens' CPUState Addr
pc (Addr -> () -> CPU r Addr
forall a (m :: * -> *). MemoryInterface a m => Addr -> a -> m Addr
`readAddr` ())
    (Addr -> Addr)
-> (Byte -> Byte) -> (Byte -> Byte) -> AddressingMode -> CPU r ()
forall r.
(Addr -> Addr)
-> (Byte -> Byte) -> (Byte -> Byte) -> AddressingMode -> CPU r ()
sh' (Addr -> Addr -> Addr
forall a b. a -> b -> a
const Addr
operand) (Byte -> Byte -> Byte
forall a. Bits a => a -> a -> a
.&. Byte
y) (Byte -> Byte -> Byte
forall a. Bits a => a -> a -> a
.&. Byte
y) AddressingMode
mode

sha :: AddressingMode -> CPU r ()
sha :: forall r. AddressingMode -> CPU r ()
sha AddressingMode
mode = 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
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
y <- 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
registerY
    (Addr -> Addr)
-> (Byte -> Byte) -> (Byte -> Byte) -> AddressingMode -> CPU r ()
forall r.
(Addr -> Addr)
-> (Byte -> Byte) -> (Byte -> Byte) -> AddressingMode -> CPU r ()
sh' (\Addr
addr -> Addr
addr Addr -> Addr -> Addr
forall a. Num a => a -> a -> a
- Byte -> Addr
byteToAddr Byte
y) (\Byte
h -> Byte
h Byte -> Byte -> Byte
forall a. Bits a => a -> a -> a
.&. Byte
a Byte -> Byte -> Byte
forall a. Bits a => a -> a -> a
.&. Byte
x) (\Byte
v -> Byte
v Byte -> Byte -> Byte
forall a. Bits a => a -> a -> a
.&. Byte
a Byte -> Byte -> Byte
forall a. Bits a => a -> a -> a
.&. Byte
x) AddressingMode
mode

shs :: AddressingMode -> CPU r ()
shs :: forall r. AddressingMode -> CPU r ()
shs AddressingMode
mode = 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
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
    Addr
operand <- Getting Addr CPUState Addr -> (Addr -> CPU r Addr) -> CPU r Addr
forall s (m :: * -> *) a r.
MonadState s m =>
Getting a s a -> (a -> m r) -> m r
usesM Getting Addr CPUState Addr
Lens' CPUState Addr
pc (Addr -> () -> CPU r Addr
forall a (m :: * -> *). MemoryInterface a m => Addr -> a -> m Addr
`readAddr` ())
    let s :: Byte
s = Byte
a Byte -> Byte -> Byte
forall a. Bits a => a -> a -> a
.&. Byte
x
    Register -> Lens' CPUState Byte
register Register
S ((Byte -> Identity Byte) -> CPUState -> Identity CPUState)
-> Byte -> CPU r ()
forall s (m :: * -> *) a.
MonadState s m =>
ASetter' s a -> a -> m ()
.= Byte
s
    (Addr -> Addr)
-> (Byte -> Byte) -> (Byte -> Byte) -> AddressingMode -> CPU r ()
forall r.
(Addr -> Addr)
-> (Byte -> Byte) -> (Byte -> Byte) -> AddressingMode -> CPU r ()
sh' (Addr -> Addr -> Addr
forall a b. a -> b -> a
const Addr
operand) (\Byte
h -> Byte
h Byte -> Byte -> Byte
forall a. Bits a => a -> a -> a
.&. Byte
a Byte -> Byte -> Byte
forall a. Bits a => a -> a -> a
.&. Byte
x) (Byte -> Byte -> Byte
forall a. Bits a => a -> a -> a
.&. Byte
s) AddressingMode
mode

sh' ::
    (Addr -> Addr) -> -- Return value from which H will be extracted. Arg is operand addr
    (Byte -> Byte) -> -- Compute the high byte of the destination addr. Arg is H + 1
    (Byte -> Byte) -> -- Compute the value to write. Arg is H + 1
    AddressingMode ->
    CPU r ()
sh' :: forall r.
(Addr -> Addr)
-> (Byte -> Byte) -> (Byte -> Byte) -> AddressingMode -> CPU r ()
sh' Addr -> Addr
getHigh Byte -> Byte
getDestHigh Byte -> Byte
getValue AddressingMode
mode = do
    (Addr
originalDest, Bool
crosses) <- AddressingMode -> CPU r (Addr, Bool)
forall r. AddressingMode -> CPU r (Addr, Bool)
getOperandAddr' AddressingMode
mode
    let high :: Byte
high = Byte
1 Byte -> Byte -> Byte
forall a. Num a => a -> a -> a
+ Addr -> Byte
unsafeAddrToByte ((Addr -> Addr
getHigh Addr
originalDest) Addr -> Int -> Addr
forall a. Bits a => a -> Int -> a
`shiftR` Int
8)
        destHigh :: Byte
destHigh = Byte -> Byte
getDestHigh Byte
high
        value :: Byte
value = Byte -> Byte
getValue Byte
high
        dest :: Addr
dest =
            if Bool
crosses
                then ((Byte -> Addr
byteToAddr Byte
destHigh) Addr -> Int -> Addr
forall a. Bits a => a -> Int -> a
`shiftL` Int
8) Addr -> Addr -> Addr
forall a. Bits a => a -> a -> a
.|. (Addr
originalDest Addr -> Addr -> Addr
forall a. Bits a => a -> a -> a
.&. Addr
0xff)
                else Addr
originalDest
    Byte -> Addr -> () -> CPU r ()
forall a (m :: * -> *).
MemoryInterface a m =>
Byte -> Addr -> a -> m ()
writeByte Byte
value Addr
dest ()

lxa :: AddressingMode -> CPU r ()
lxa :: forall r. AddressingMode -> CPU r ()
lxa = AddressingMode -> CPU r ()
forall r. AddressingMode -> CPU r ()
lda (AddressingMode -> CPU r ())
-> (() -> CPU r ()) -> AddressingMode -> CPU r ()
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> CPU r () -> () -> CPU r ()
forall a b. a -> b -> a
const CPU r ()
forall r. CPU r ()
tax

axs :: AddressingMode -> CPU r ()
axs :: forall r. AddressingMode -> CPU r ()
axs 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 ()
    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
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
    let xAndA :: Byte
xAndA = Byte
x Byte -> Byte -> Byte
forall a. Bits a => a -> a -> a
.&. Byte
a
    let res :: Byte
res = Byte
xAndA Byte -> Byte -> Byte
forall a. Num a => a -> a -> a
- 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
byte Byte -> Byte -> Bool
forall a. Ord a => a -> a -> Bool
<= Byte
xAndA))
    Register -> Lens' CPUState Byte
register Register
X ((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 ()
forall r. Byte -> CPU r ()
setZeroAndNegativeFlags Byte
res