module Nes.CPU.Interrupt (handleInterrupt) where

import Control.Monad
import Nes.APU.Monad (modifyDMCAndInterrupt)
import Nes.APU.State
import Nes.APU.State.DMC (DMC (sampleBufferAddr), loadSampleBuffer)
import Nes.Bus.Monad (liftAPU)
import Nes.Bus.State
import Nes.CPU.Monad
import Nes.CPU.State
import Nes.FlagRegister
import Nes.Internal.MonadState
import Nes.Interrupt
import Nes.Memory

data Signal = NMI | IRQ IRQSource deriving (Signal -> Signal -> Bool
(Signal -> Signal -> Bool)
-> (Signal -> Signal -> Bool) -> Eq Signal
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Signal -> Signal -> Bool
== :: Signal -> Signal -> Bool
$c/= :: Signal -> Signal -> Bool
/= :: Signal -> Signal -> Bool
Eq)

{-# INLINE signalFromInterrupt #-}
signalFromInterrupt :: InterruptStatus -> Maybe Signal
signalFromInterrupt :: InterruptStatus -> Maybe Signal
signalFromInterrupt InterruptStatus
s
    | InterruptStatus -> Bool
nmi InterruptStatus
s = Signal -> Maybe Signal
forall a. a -> Maybe a
Just Signal
NMI
    | Bool
otherwise = IRQSource -> Signal
IRQ (IRQSource -> Signal) -> Maybe IRQSource -> Maybe Signal
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> InterruptStatus -> Maybe IRQSource
irq InterruptStatus
s

signalShouldPushBFlag :: Signal -> Bool
signalShouldPushBFlag :: Signal -> Bool
signalShouldPushBFlag = \case
    Signal
NMI -> Bool
False
    IRQ IRQSource
BRK -> Bool
True
    IRQ IRQSource
_ -> Bool
False

signalVectorAddr :: Signal -> Addr
signalVectorAddr :: Signal -> Addr
signalVectorAddr = \case
    Signal
NMI -> Addr
0xfffa
    IRQ IRQSource
_ -> Addr
0xfffe

handleInterrupt :: CPU r ()
handleInterrupt :: forall r. CPU r ()
handleInterrupt = do
    Bool
maskInterrupt <- 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
InterruptDisable
    Maybe Signal
pendingSignal <- InterruptStatus -> Maybe Signal
signalFromInterrupt (InterruptStatus -> Maybe Signal)
-> CPU r InterruptStatus -> CPU r (Maybe Signal)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Getting InterruptStatus BusState InterruptStatus
-> CPU r InterruptStatus
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting InterruptStatus BusState InterruptStatus
Lens' BusState InterruptStatus
cpuInterrupt
    case Maybe Signal
pendingSignal of
        Maybe Signal
Nothing -> () -> CPU r ()
forall a. a -> CPU r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
        Just Signal
signal
            | Bool
maskInterrupt Bool -> Bool -> Bool
&& Signal
signal Signal -> Signal -> Bool
forall a. Eq a => a -> a -> Bool
/= Signal
NMI Bool -> Bool -> Bool
&& Signal
signal Signal -> Signal -> Bool
forall a. Eq a => a -> a -> Bool
/= IRQSource -> Signal
IRQ IRQSource
BRK -> () -> CPU r ()
forall a. a -> CPU r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
            | Bool
otherwise -> do
                Addr -> CPU r ()
forall r. Addr -> CPU r ()
pushAddrStack (Addr -> CPU r ()) -> CPU r Addr -> CPU r ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m 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
                Bool -> CPU r ()
forall r. Bool -> CPU r ()
pushStatusRegister (Signal -> Bool
signalShouldPushBFlag Signal
signal)
                (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
InterruptDisable
                ((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 =>
ASetter' s a -> a -> m ()
.=) (Addr -> CPU r ()) -> CPU r Addr -> CPU r ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Addr -> () -> CPU r Addr
forall a (m :: * -> *). MemoryInterface a m => Addr -> a -> m Addr
readAddr (Signal -> Addr
signalVectorAddr Signal
signal) ()
    -- TODO Ugly, shouldn't be here
    Bool -> CPU r () -> CPU r ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe Signal
pendingSignal Maybe Signal -> Maybe Signal -> Bool
forall a. Eq a => a -> a -> Bool
== Signal -> Maybe Signal
forall a. a -> Maybe a
Just (IRQSource -> Signal
IRQ IRQSource
DMC)) (CPU r () -> CPU r ()) -> CPU r () -> CPU r ()
forall a b. (a -> b) -> a -> b
$ Bus ((), BusState) () -> CPU r ()
forall a r. Bus (a, BusState) a -> CPU r a
liftBus (Bus ((), BusState) () -> CPU r ())
-> Bus ((), BusState) () -> CPU r ()
forall a b. (a -> b) -> a -> b
$ do
        Addr
sampleByteAddr <- DMC -> Addr
sampleBufferAddr (DMC -> Addr) -> (APUState -> DMC) -> APUState -> Addr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. APUState -> DMC
_dmc (APUState -> Addr)
-> Bus ((), BusState) APUState -> Bus ((), BusState) Addr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Getting APUState BusState APUState -> Bus ((), BusState) APUState
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting APUState BusState APUState
Lens' BusState APUState
apuState
        Byte
sample <- Addr -> () -> Bus ((), BusState) Byte
forall a (m :: * -> *). MemoryInterface a m => Addr -> a -> m Byte
Nes.Memory.readByte Addr
sampleByteAddr ()
        APU ((), APUState, InterruptStatus) () -> Bus ((), BusState) ()
forall a r. APU (a, APUState, InterruptStatus) a -> Bus r a
liftAPU (APU ((), APUState, InterruptStatus) () -> Bus ((), BusState) ())
-> APU ((), APUState, InterruptStatus) () -> Bus ((), BusState) ()
forall a b. (a -> b) -> a -> b
$ (DMC -> InterruptStatus -> (DMC, InterruptStatus))
-> APU ((), APUState, InterruptStatus) ()
forall r.
(DMC -> InterruptStatus -> (DMC, InterruptStatus)) -> APU r ()
modifyDMCAndInterrupt ((DMC -> InterruptStatus -> (DMC, InterruptStatus))
 -> APU ((), APUState, InterruptStatus) ())
-> (DMC -> InterruptStatus -> (DMC, InterruptStatus))
-> APU ((), APUState, InterruptStatus) ()
forall a b. (a -> b) -> a -> b
$ Byte -> DMC -> InterruptStatus -> (DMC, InterruptStatus)
loadSampleBuffer Byte
sample
    -- Cleanup state
    case Maybe Signal
pendingSignal of
        Maybe Signal
Nothing -> () -> CPU r ()
forall a. a -> CPU r a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        Just Signal
NMI -> (InterruptStatus -> InterruptStatus) -> CPU r ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((InterruptStatus -> InterruptStatus) -> CPU r ())
-> (InterruptStatus -> InterruptStatus) -> CPU r ()
forall a b. (a -> b) -> a -> b
$ \InterruptStatus
s -> InterruptStatus
s{nmi = False}
        Just (IRQ IRQSource
_) -> (InterruptStatus -> InterruptStatus) -> CPU r ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((InterruptStatus -> InterruptStatus) -> CPU r ())
-> (InterruptStatus -> InterruptStatus) -> CPU r ()
forall a b. (a -> b) -> a -> b
$ \InterruptStatus
s -> InterruptStatus
s{irq = Nothing}