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

module Nes.CPU.Instructions.Addressing (
    AddressingMode (..),
    getOperandAddr,
    getOperandAddr',
    getOperandSize,
) where

import Control.Monad
import Data.Bits
import Data.Int (Int8)
import Nes.CPU.Monad
import Nes.CPU.State
import Nes.Internal.MonadState
import Nes.Memory
import Text.Printf (printf)

-- | Mode that say how to get an Op code's parameter
--
-- https://www.nesdev.org/obelisk-6502-guide/addressing.html#IMM
data AddressingMode
    = Immediate
    | Accumulator
    | Relative
    | ZeroPage
    | ZeroPageX
    | ZeroPageY
    | Absolute
    | AbsoluteX
    | AbsoluteY
    | Indirect
    | IndirectX
    | IndirectY
    | None
    deriving (AddressingMode -> AddressingMode -> Bool
(AddressingMode -> AddressingMode -> Bool)
-> (AddressingMode -> AddressingMode -> Bool) -> Eq AddressingMode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AddressingMode -> AddressingMode -> Bool
== :: AddressingMode -> AddressingMode -> Bool
$c/= :: AddressingMode -> AddressingMode -> Bool
/= :: AddressingMode -> AddressingMode -> Bool
Eq, Int -> AddressingMode -> ShowS
[AddressingMode] -> ShowS
AddressingMode -> String
(Int -> AddressingMode -> ShowS)
-> (AddressingMode -> String)
-> ([AddressingMode] -> ShowS)
-> Show AddressingMode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AddressingMode -> ShowS
showsPrec :: Int -> AddressingMode -> ShowS
$cshow :: AddressingMode -> String
show :: AddressingMode -> String
$cshowList :: [AddressingMode] -> ShowS
showList :: [AddressingMode] -> ShowS
Show)

-- | Gives the address of the current op code's parameter
--
-- Will shift PC accordingly and ticks once when page is crossed
--
-- Source: https://bugzmanov.github.io/nes_ebook/chapter_3_2.html
getOperandAddr :: AddressingMode -> CPU r Addr
getOperandAddr :: forall r. AddressingMode -> CPU r Addr
getOperandAddr AddressingMode
mode = do
    (Addr
res, Bool
crosses) <- AddressingMode -> CPU r (Addr, Bool)
forall r. AddressingMode -> CPU r (Addr, Bool)
getOperandAddr' AddressingMode
mode
    Bool -> CPU r () -> CPU r ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool
crosses Bool -> Bool -> Bool
&& AddressingMode
mode AddressingMode -> AddressingMode -> Bool
forall a. Eq a => a -> a -> Bool
/= AddressingMode
IndirectY Bool -> Bool -> Bool
&& AddressingMode
mode AddressingMode -> AddressingMode -> Bool
forall a. Eq a => a -> a -> Bool
/= AddressingMode
AbsoluteY Bool -> Bool -> Bool
&& AddressingMode
mode AddressingMode -> AddressingMode -> Bool
forall a. Eq a => a -> a -> Bool
/= AddressingMode
AbsoluteX) CPU r ()
forall r. CPU r ()
tickOnce
    Addr -> CPU r Addr
forall a. a -> CPU r a
forall (m :: * -> *) a. Monad m => a -> m a
return Addr
res

-- | Gives the address of the current op code's parameter
--
-- Will shift PC accordingly, but does not tick when page is crossed
getOperandAddr' :: AddressingMode -> CPU r (Addr, Bool)
getOperandAddr' :: forall r. AddressingMode -> CPU r (Addr, Bool)
getOperandAddr' AddressingMode
mode = do
    (Addr
res, Bool
crosses) <- AddressingMode -> CPU r (Addr, Bool)
forall r. AddressingMode -> CPU r (Addr, Bool)
getOperandAddr'' AddressingMode
mode
    let offset :: Addr
offset = Word16 -> Addr
Addr (Word16 -> Addr) -> Word16 -> Addr
forall a b. (a -> b) -> a -> b
$ Int -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word16) -> Int -> Word16
forall a b. (a -> b) -> a -> b
$ AddressingMode -> Int
getOperandSize AddressingMode
mode
    (Addr -> Identity Addr) -> CPUState -> Identity CPUState
Lens' CPUState Addr
pc ((Addr -> Identity Addr) -> CPUState -> Identity CPUState)
-> Addr -> CPU r ()
forall s (m :: * -> *) a.
(MonadState s m, Num a) =>
ASetter' s a -> a -> m ()
+= Addr
offset
    (Addr, Bool) -> CPU r (Addr, Bool)
forall a. a -> CPU r a
forall (m :: * -> *) a. Monad m => a -> m a
return (Addr
res, Bool
crosses)

-- | Gives the address of the current op code's parameter
--
-- Does not shift the PC, does not tick when page is crossed by tick when reading bytes
getOperandAddr'' :: AddressingMode -> CPU r (Addr, Bool)
getOperandAddr'' :: forall r. AddressingMode -> CPU r (Addr, Bool)
getOperandAddr'' = \case
    AddressingMode
Accumulator -> String -> CPU r (Addr, Bool)
forall a. String -> CPU r a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Do not use this function when the mode is Accumulator"
    AddressingMode
Immediate -> (,Bool
False) (Addr -> (Addr, Bool)) -> CPU r Addr -> CPU r (Addr, Bool)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Getting Addr CPUState Addr -> CPU r Addr
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting Addr CPUState Addr
Lens' CPUState Addr
pc
    AddressingMode
Relative -> do
        Addr
pc' <- Getting Addr CPUState Addr -> CPU r Addr
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting Addr CPUState Addr
Lens' CPUState Addr
pc
        Byte
offset <- Addr -> () -> CPU r Byte
forall a (m :: * -> *). MemoryInterface a m => Addr -> a -> m Byte
readByte Addr
pc' ()
        let intPC :: Int
intPC = Addr -> Int
addrToInt Addr
pc'
            -- Note we need to wrap the unsinged word into a signed value
            -- See https://www.nesdev.org/wiki/Instruction_reference#BPL
            signedOffset :: Int
signedOffset = Int8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> Int8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Byte -> Word8
unByte Byte
offset) :: Int8)
            res :: Addr
res = Word16 -> Addr
Addr (Word16 -> Addr) -> Word16 -> Addr
forall a b. (a -> b) -> a -> b
$ Int -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word16) -> Int -> Word16
forall a b. (a -> b) -> a -> b
$ Int
intPC Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
signedOffset
        (Addr, Bool) -> CPU r (Addr, Bool)
forall a. a -> CPU r a
forall (m :: * -> *) a. Monad m => a -> m a
return (Addr
res, Addr -> Addr -> Bool
crossesPage (Int -> Addr
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Addr) -> Int -> Addr
forall a b. (a -> b) -> a -> b
$ Int
intPC Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Addr
res)
    AddressingMode
ZeroPage -> do
        Byte
arg <- Getting Addr CPUState Addr -> (Addr -> CPU r Byte) -> CPU r Byte
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 Byte
forall a (m :: * -> *). MemoryInterface a m => Addr -> a -> m Byte
`readByte` ())
        (Addr, Bool) -> CPU r (Addr, Bool)
forall a. a -> CPU r a
forall (m :: * -> *) a. Monad m => a -> m a
return (Byte -> Addr
byteToAddr Byte
arg, Bool
False)
    AddressingMode
ZeroPageX -> Register -> CPU r (Addr, Bool)
forall r. Register -> CPU r (Addr, Bool)
zeroPageAddressing Register
X
    AddressingMode
ZeroPageY -> Register -> CPU r (Addr, Bool)
forall r. Register -> CPU r (Addr, Bool)
zeroPageAddressing Register
Y
    AddressingMode
Absolute -> do
        Addr
pc' <- Getting Addr CPUState Addr -> CPU r Addr
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting Addr CPUState Addr
Lens' CPUState Addr
pc
        Addr
addr <- Addr -> () -> CPU r Addr
forall a (m :: * -> *). MemoryInterface a m => Addr -> a -> m Addr
readAddr Addr
pc' ()
        (Addr, Bool) -> CPU r (Addr, Bool)
forall a. a -> CPU r a
forall (m :: * -> *) a. Monad m => a -> m a
return (Addr
addr, Bool
False)
    AddressingMode
AbsoluteX -> Register -> CPU r (Addr, Bool)
forall r. Register -> CPU r (Addr, Bool)
absoluteAddressing Register
X
    AddressingMode
AbsoluteY -> Register -> CPU r (Addr, Bool)
forall r. Register -> CPU r (Addr, Bool)
absoluteAddressing Register
Y
    -- No need to increment PC here. Mode is only used by jmp
    AddressingMode
Indirect -> do
        Addr
pc' <- Getting Addr CPUState Addr -> CPU r Addr
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting Addr CPUState Addr
Lens' CPUState Addr
pc
        Addr
addr1 <- Addr -> () -> CPU r Addr
forall a (m :: * -> *). MemoryInterface a m => Addr -> a -> m Addr
readAddr Addr
pc' ()
        Addr
addr2 <- Addr -> () -> CPU r Addr
forall a (m :: * -> *). MemoryInterface a m => Addr -> a -> m Addr
readAddr Addr
addr1 ()
        (Addr, Bool) -> CPU r (Addr, Bool)
forall a. a -> CPU r a
forall (m :: * -> *) a. Monad m => a -> m a
return (Addr
addr2, Bool
False)
    AddressingMode
IndirectX -> do
        -- Note: we do not convert the ptr to an Addr because we need the overflow to happen
        Byte
base <- Getting Addr CPUState Addr -> (Addr -> CPU r Byte) -> CPU r Byte
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 Byte
forall a (m :: * -> *). MemoryInterface a m => Addr -> a -> m Byte
`readByte` ())
        Byte
ptr <- Getting Byte CPUState Byte -> (Byte -> Byte) -> CPU r Byte
forall s (m :: * -> *) a r.
MonadState s m =>
Getting a s a -> (a -> r) -> m r
uses (Register -> Lens' CPUState Byte
register Register
X) (Byte -> Byte -> Byte
forall a. Num a => a -> a -> a
+ Byte
base)
        Byte
low <- Addr -> () -> CPU r Byte
forall a (m :: * -> *). MemoryInterface a m => Addr -> a -> m Byte
readByte (Byte -> Addr
byteToAddr Byte
ptr) ()
        Byte
high <- Addr -> () -> CPU r Byte
forall a (m :: * -> *). MemoryInterface a m => Addr -> a -> m Byte
readByte (Byte -> Addr
byteToAddr (Byte
ptr Byte -> Byte -> Byte
forall a. Num a => a -> a -> a
+ Byte
1)) ()
        let res :: Addr
res = Byte -> Byte -> Addr
bytesToAddr Byte
low Byte
high
        (Addr, Bool) -> CPU r (Addr, Bool)
forall a. a -> CPU r a
forall (m :: * -> *) a. Monad m => a -> m a
return (Addr
res, Addr -> Addr -> Bool
crossesPage (Byte -> Addr
byteToAddr Byte
ptr) Addr
res)
    AddressingMode
IndirectY -> do
        Byte
ptr <- Getting Addr CPUState Addr -> (Addr -> CPU r Byte) -> CPU r Byte
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 Byte
forall a (m :: * -> *). MemoryInterface a m => Addr -> a -> m Byte
`readByte` ())
        Byte
low <- Addr -> () -> CPU r Byte
forall a (m :: * -> *). MemoryInterface a m => Addr -> a -> m Byte
readByte (Byte -> Addr
byteToAddr Byte
ptr) ()
        Byte
high <- Addr -> () -> CPU r Byte
forall a (m :: * -> *). MemoryInterface a m => Addr -> a -> m Byte
readByte (Byte -> Addr
byteToAddr (Byte
ptr Byte -> Byte -> Byte
forall a. Num a => a -> a -> a
+ Byte
1)) ()
        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
        let derefBase :: Addr
derefBase = Byte -> Byte -> Addr
bytesToAddr Byte
low Byte
high
            deref :: Addr
deref = Addr
derefBase Addr -> Addr -> Addr
forall a. Num a => a -> a -> a
+ Byte -> Addr
byteToAddr Byte
y
            crosses :: Bool
crosses = Addr -> Addr -> Bool
crossesPage Addr
deref Addr
derefBase
        Bool -> CPU r () -> CPU r ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
crosses (CPU r () -> CPU r ()) -> CPU r () -> CPU r ()
forall a b. (a -> b) -> a -> b
$ do
            let bogusAddr :: Addr
bogusAddr = (Byte -> Addr
byteToAddr Byte
high Addr -> Int -> Addr
forall a. Bits a => a -> Int -> a
`shiftL` Int
8) Addr -> Addr -> Addr
forall a. Bits a => a -> a -> a
.|. Byte -> Addr
byteToAddr (Byte
y Byte -> Byte -> Byte
forall a. Num a => a -> a -> a
+ Byte
low)
            Byte
_ <- Addr -> () -> CPU r Byte
forall a (m :: * -> *). MemoryInterface a m => Addr -> a -> m Byte
readByte Addr
bogusAddr ()
            () -> CPU r ()
forall a. a -> CPU r a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        (Addr, Bool) -> CPU r (Addr, Bool)
forall a. a -> CPU r a
forall (m :: * -> *) a. Monad m => a -> m a
return (Addr
deref, Addr -> Addr -> Bool
crossesPage Addr
deref Addr
derefBase)
    AddressingMode
None -> String -> CPU r (Addr, Bool)
forall a. String -> CPU r a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> CPU r (Addr, Bool)) -> String -> CPU r (Addr, Bool)
forall a b. (a -> b) -> a -> b
$ String -> ShowS
forall r. PrintfType r => String -> r
printf String
"Mode not supported: %s" ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ AddressingMode -> String
forall a. Show a => a -> String
show AddressingMode
None

{-# INLINE zeroPageAddressing #-}
zeroPageAddressing :: Register -> CPU r (Addr, Bool)
zeroPageAddressing :: forall r. Register -> CPU r (Addr, Bool)
zeroPageAddressing Register
reg = do
    Byte
pos <- Getting Addr CPUState Addr -> (Addr -> CPU r Byte) -> CPU r Byte
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 Byte
forall a (m :: * -> *). MemoryInterface a m => Addr -> a -> m Byte
`readByte` ())
    Byte
regVal <- 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 -> CPU r Byte)
-> Getting Byte CPUState Byte -> CPU r Byte
forall a b. (a -> b) -> a -> b
$ Register -> Lens' CPUState Byte
register Register
reg
    CPU r ()
forall r. CPU r ()
tickOnce
    (Addr, Bool) -> CPU r (Addr, Bool)
forall a. a -> CPU r a
forall (m :: * -> *) a. Monad m => a -> m a
return (Byte -> Addr
byteToAddr (Byte -> Addr) -> Byte -> Addr
forall a b. (a -> b) -> a -> b
$ Byte
pos Byte -> Byte -> Byte
forall a. Num a => a -> a -> a
+ Byte
regVal, Bool
False)

{-# INLINE absoluteAddressing #-}
absoluteAddressing :: Register -> CPU r (Addr, Bool)
absoluteAddressing :: forall r. Register -> CPU r (Addr, Bool)
absoluteAddressing Register
reg = do
    Addr
base <- 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` ())
    Byte
offset <- 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 -> CPU r Byte)
-> Getting Byte CPUState Byte -> CPU r Byte
forall a b. (a -> b) -> a -> b
$ Register -> Lens' CPUState Byte
register Register
reg
    let addr :: Addr
addr = Byte -> Addr
byteToAddr Byte
offset Addr -> Addr -> Addr
forall a. Num a => a -> a -> a
+ Addr
base
    let crosses :: Bool
crosses = Addr -> Addr -> Bool
crossesPage Addr
base Addr
addr
    -- Dummy read
    Bool -> CPU r () -> CPU r ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
crosses (CPU r () -> CPU r ()) -> CPU r () -> CPU r ()
forall a b. (a -> b) -> a -> b
$ do
        let bogusAddr :: Addr
bogusAddr = (Addr
base Addr -> Addr -> Addr
forall a. Bits a => a -> a -> a
.&. Addr
0xff00) Addr -> Addr -> Addr
forall a. Bits a => a -> a -> a
.|. Byte -> Addr
byteToAddr (Byte
offset Byte -> Byte -> Byte
forall a. Num a => a -> a -> a
+ Addr -> Byte
unsafeAddrToByte (Addr
base Addr -> Addr -> Addr
forall a. Bits a => a -> a -> a
.&. Addr
0xff))
        Byte
_ <- Addr -> () -> CPU r Byte
forall a (m :: * -> *). MemoryInterface a m => Addr -> a -> m Byte
readByte Addr
bogusAddr ()
        () -> CPU r ()
forall a. a -> CPU r a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    --
    (Addr, Bool) -> CPU r (Addr, Bool)
forall a. a -> CPU r a
forall (m :: * -> *) a. Monad m => a -> m a
return (Addr
addr, Bool
crosses)

{-# INLINE crossesPage #-}
crossesPage :: Addr -> Addr -> Bool
crossesPage :: Addr -> Addr -> Bool
crossesPage (Addr Word16
addr1) (Addr Word16
addr2) = Word16
addr1 Word16 -> Word16 -> Word16
forall a. Bits a => a -> a -> a
.&. Word16
0xFF00 Word16 -> Word16 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word16
addr2 Word16 -> Word16 -> Word16
forall a. Bits a => a -> a -> a
.&. Word16
0xFF00

{-# INLINE getOperandSize #-}
getOperandSize :: AddressingMode -> Int
getOperandSize :: AddressingMode -> Int
getOperandSize = \case
    AddressingMode
Immediate -> Int
1
    AddressingMode
Accumulator -> Int
0
    AddressingMode
Relative -> Int
1
    AddressingMode
ZeroPage -> Int
1
    AddressingMode
ZeroPageX -> Int
1
    AddressingMode
ZeroPageY -> Int
1
    AddressingMode
Absolute -> Int
2
    AddressingMode
AbsoluteX -> Int
2
    AddressingMode
AbsoluteY -> Int
2
    AddressingMode
Indirect -> Int
2
    AddressingMode
IndirectX -> Int
1
    AddressingMode
IndirectY -> Int
1
    AddressingMode
None -> Int
0