module Nes.CPU.Interpreter (
    runProgram,
    runProgram',
    interpretWithCallback,
) where

import Control.Monad
import Control.Monad.IO.Class
import Data.Functor
import Data.Map
import Nes.Bus.Monad
import Nes.Bus.State
import Nes.CPU.Instructions.Map
import Nes.CPU.Interrupt (handleInterrupt)
import Nes.CPU.Monad
import Nes.CPU.State
import Nes.Internal.MonadState
import Nes.Interrupt
import Nes.Memory
import Nes.PPU.State (nmiInterrupt)
import Text.Printf

-- | Runs the program that's on the memory (interfaced by the given 'Bus').
--
-- The second argument is a callback run at each loop.
--
-- Returns the state of the CPU with the number of ellapsed ticks
runProgram :: BusState -> CPU (CPUState, Integer) () -> IO (CPUState, Integer)
runProgram :: BusState -> CPU (CPUState, Integer) () -> IO (CPUState, Integer)
runProgram BusState
prog CPU (CPUState, Integer) ()
callback = CPU (CPUState, Integer) ()
-> CPUState
-> BusState
-> (CPUState -> BusState -> () -> IO (CPUState, Integer))
-> IO (CPUState, Integer)
forall r a.
CPU r a
-> CPUState
-> BusState
-> (CPUState -> BusState -> a -> IO r)
-> IO r
unCPU
    (CPU (CPUState, Integer) ()
forall r. CPU r ()
reset CPU (CPUState, Integer) ()
-> CPU (CPUState, Integer) () -> CPU (CPUState, Integer) ()
forall a b.
CPU (CPUState, Integer) a
-> CPU (CPUState, Integer) b -> CPU (CPUState, Integer) b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> CPU (CPUState, Integer) () -> CPU (CPUState, Integer) ()
forall r. CPU r () -> CPU r ()
interpretWithCallback CPU (CPUState, Integer) ()
callback)
    CPUState
newCPUState
    BusState
prog
    ((CPUState -> BusState -> () -> IO (CPUState, Integer))
 -> IO (CPUState, Integer))
-> (CPUState -> BusState -> () -> IO (CPUState, Integer))
-> IO (CPUState, Integer)
forall a b. (a -> b) -> a -> b
$ \CPUState
state' BusState
bus ()
_ -> (CPUState, Integer) -> IO (CPUState, Integer)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (CPUState
state', BusState -> Integer
_cycles BusState
bus)

-- | Same as 'runProgram', but uses a given state
runProgram' :: CPUState -> BusState -> CPU (CPUState, Integer) () -> IO (CPUState, Integer)
runProgram' :: CPUState
-> BusState -> CPU (CPUState, Integer) () -> IO (CPUState, Integer)
runProgram' CPUState
state BusState
prog CPU (CPUState, Integer) ()
callback = CPU (CPUState, Integer) ()
-> CPUState
-> BusState
-> (CPUState -> BusState -> () -> IO (CPUState, Integer))
-> IO (CPUState, Integer)
forall r a.
CPU r a
-> CPUState
-> BusState
-> (CPUState -> BusState -> a -> IO r)
-> IO r
unCPU (CPU (CPUState, Integer) () -> CPU (CPUState, Integer) ()
forall r. CPU r () -> CPU r ()
interpretWithCallback CPU (CPUState, Integer) ()
callback) CPUState
state BusState
prog ((CPUState -> BusState -> () -> IO (CPUState, Integer))
 -> IO (CPUState, Integer))
-> (CPUState -> BusState -> () -> IO (CPUState, Integer))
-> IO (CPUState, Integer)
forall a b. (a -> b) -> a -> b
$ \CPUState
state' BusState
bus ()
_ -> (CPUState, Integer) -> IO (CPUState, Integer)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (CPUState
state', BusState -> Integer
_cycles BusState
bus)

-- | Interpretation loop of the program
interpretWithCallback :: CPU r () -> CPU r ()
interpretWithCallback :: forall r. CPU r () -> CPU r ()
interpretWithCallback CPU r ()
callback = do
    Bool
hasNmiInterrupt <-
        Bus (Bool, BusState) Bool -> CPU r Bool
forall a r. Bus (a, BusState) a -> CPU r a
liftBus
            ( PPU (Bool, PPUState) Bool -> Bus (Bool, BusState) Bool
forall a r. PPU (a, PPUState) a -> Bus r a
liftPPU (PPU (Bool, PPUState) Bool -> Bus (Bool, BusState) Bool)
-> PPU (Bool, PPUState) Bool -> Bus (Bool, BusState) Bool
forall a b. (a -> b) -> a -> b
$ do
                Bool
f <- Getting Bool PPUState Bool -> PPU (Bool, PPUState) Bool
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting Bool PPUState Bool
Lens' PPUState Bool
nmiInterrupt
                (Bool -> Identity Bool) -> PPUState -> Identity PPUState
Lens' PPUState Bool
nmiInterrupt ((Bool -> Identity Bool) -> PPUState -> Identity PPUState)
-> Bool -> PPU (Bool, PPUState) ()
forall s (m :: * -> *) a.
MonadState s m =>
ASetter' s a -> a -> m ()
.= Bool
False
                Bool -> PPU (Bool, PPUState) Bool
forall a. a -> PPU (Bool, PPUState) a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
f
            )
    Bool -> CPU r () -> CPU r ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
hasNmiInterrupt (CPU r () -> CPU r ()) -> CPU r () -> CPU r ()
forall a b. (a -> b) -> a -> b
$ (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 = True}
    CPU r ()
callback
    Integer
oldCycleCount <- Getting Integer BusState Integer -> CPU r Integer
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting Integer BusState Integer
Lens' BusState Integer
cycles
    Byte
opCode <- CPU r Byte
forall r. CPU r Byte
readAtPC
    CPU r ()
forall r. CPU r ()
incrementPC
    Bool
forceMultiByte <- Byte -> CPU r Bool
forall {r}. Byte -> CPU r Bool
go Byte
opCode
    Integer
newCycleCount <- Getting Integer BusState Integer -> CPU r Integer
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting Integer BusState Integer
Lens' BusState Integer
cycles
    -- Each opcode should take at least 2 ticks
    -- We cannot just check that addressing is none,
    -- because some opcode w/o addressing take more that 1 cycle
    -- e.g. php
    -- This does not apply to unofficial KIL/JAM opcodes
    Bool -> CPU r () -> CPU r ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool
forceMultiByte Bool -> Bool -> Bool
&& Integer
newCycleCount Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
1 Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
oldCycleCount) CPU r ()
forall r. CPU r ()
tickOnce
    CPU r ()
forall r. CPU r ()
handleInterrupt
    CPU r () -> CPU r ()
forall r. CPU r () -> CPU r ()
interpretWithCallback CPU r ()
callback
  where
    {-# INLINE go #-}
    go :: Byte -> CPU r Bool
go Byte
opcode = case Byte -> Map Byte (OpCodeEntry r) -> Maybe (OpCodeEntry r)
forall k a. Ord k => k -> Map k a -> Maybe a
Data.Map.lookup Byte
opcode Map Byte (OpCodeEntry r)
forall r. Map Byte (OpCodeEntry r)
opcodeMap of
        Just (ByteString
mnemo, AddressingMode -> CPU r ()
f, AddressingMode
mode, OpType
_) -> AddressingMode -> CPU r ()
f AddressingMode
mode CPU r () -> Bool -> CPU r Bool
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> (ByteString
mnemo ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
/= ByteString
"KIL")
        Maybe (OpCodeEntry r)
Nothing -> do
            CPU r ()
forall r. CPU r ()
incrementPC
            IO () -> CPU r ()
forall a. IO a -> CPU r a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> CPU r ()) -> IO () -> CPU r ()
forall a b. (a -> b) -> a -> b
$ String -> Word8 -> IO ()
forall r. PrintfType r => String -> r
printf String
"OP Code not implemented: 0x%x\n" (Byte -> Word8
unByte Byte
opcode)
            Bool -> CPU r Bool
forall a. a -> CPU r a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False