Remove fig-emulator-gb

13 files changed, 0 insertions, 1918 deletions

diff --git a/fig-emulator-gb/src/Fig/Emulator/GB.hs b/fig-emulator-gb/src/Fig/Emulator/GB.hs
deleted file mode 100644
index a2cfa1d..0000000
--- a/fig-emulator-gb/src/Fig/Emulator/GB.hs
+++ /dev/null
@@ -1,91 +0,0 @@
-module Fig.Emulator.GB where
-
-import Prelude (error)
-import Fig.Prelude
-
-import System.IO (withFile, IOMode (WriteMode))
-
-import Control.Lens ((.=), use)
-import Control.Monad (when)
-import Control.Monad.State.Strict (StateT(..))
-
-import qualified Data.Vector as V
-import qualified Data.ByteString as BS
-
-import qualified SDL
-
-import Fig.Emulator.GB.CPU
-import Fig.Emulator.GB.CPU.Instruction
-import Fig.Emulator.GB.Bus (Bus(..), Addr(..))
-import Fig.Emulator.GB.Component.RAM
-import Fig.Emulator.GB.Component.ROM
-import Fig.Emulator.GB.Component.Video
-import Fig.Emulator.GB.Component.Joystick
-import Fig.Emulator.GB.Component.Serial
-import Fig.Emulator.GB.Component.Misc
-import Fig.Emulator.GB.Component.Interrupt
-
-cpuDMG :: Maybe Handle -> ByteString -> Framebuffer -> CPU
-cpuDMG serial rom fb = CPU
-  { _lastPC = 0x0
-  , _lastIns = Nop
-  , _running = True
-  , _regs = initialRegs
-  , _bus = Bus
-    [ compROM rom
-    , compWRAM 0xc000 $ 8 * 1024
-    , compVideo fb
-    , compJoystick
-    , compSerial serial
-    , compInterrupt
-    , compMisc
-    , compWRAM 0xff80 0x7e -- HRAM
-    ]
-  }
-
-testRun :: Maybe FilePath -> ByteString -> IO ()
-testRun serialOut rom = do
-  SDL.initializeAll
-  window <- SDL.createWindow "taking" SDL.defaultWindow
-  fb <- initializeFramebuffer
-  let withSerial f = case serialOut of
-        Nothing -> f Nothing
-        Just p -> withFile p WriteMode $ f . Just
-  liftIO $ withSerial \hserial -> do
-    let cpu = cpuDMG hserial rom fb
-    let
-      loop :: Int -> Emulating ()
-      loop cycle = do
-        events <- SDL.pollEvents
-        forM_ events \ev ->
-          case SDL.eventPayload ev of
-            SDL.QuitEvent -> running .= False
-            _else -> pure ()
-        pc <- use $ regs . regPC
-        ins <- decode
-        when (pc == 0x2817) do
-          log $ mconcat
-            [ pretty $ Addr pc
-            , ": ", tshow ins
-            ]
-        step ins
-        when (rem cycle 1000000 == 0) do
-          log "1 million"
-        when (rem cycle 300000 == 0) do
-          ws <- SDL.getWindowSurface window
-          SDL.surfaceFillRect ws Nothing $ SDL.V4 0x00 0x00 0x00 0xff
-          void $
-            SDL.surfaceBlitScaled
-            (fbSurface fb)
-            Nothing
-            ws
-            (Just $ SDL.Rectangle
-             (SDL.P $ SDL.V2 0 0)
-             (SDL.V2
-              (fromIntegral screenWidth * 4)
-              (fromIntegral screenHeight * 4)))
-          SDL.updateWindowSurface window
-        r <- use running
-        when r . loop $ cycle + 1
-    void $ flip (runStateT . runEmulating) cpu do
-      loop 0
diff --git a/fig-emulator-gb/src/Fig/Emulator/GB/Bus.hs b/fig-emulator-gb/src/Fig/Emulator/GB/Bus.hs
deleted file mode 100644
index 2b71f2f..0000000
--- a/fig-emulator-gb/src/Fig/Emulator/GB/Bus.hs
+++ /dev/null
@@ -1,48 +0,0 @@
-module Fig.Emulator.GB.Bus
-  ( Addr(..)
-  , Component(..)
-  , Bus(..)
-  , update
-  , write
-  , read
-  ) where
-
-import Fig.Prelude
-
-import Numeric (showHex)
-
-import qualified Data.List as List
-import Data.Word (Word16, Word8)
-
-newtype Addr = Addr { unAddr :: Word16 }
-  deriving (Show, Num, Eq, Ord)
-instance Pretty Addr where
-  pretty (Addr w) = "$" <> pack (showHex w "")
-
-data Component = forall (s :: Type). Component
-  { compState :: !s
-  , compMatches :: !(Addr -> Bool)
-  , compUpdate :: !(s -> Word16 -> IO s)
-  , compWrite :: !(s -> Addr -> Word8 -> IO s)
-  , compRead :: !(s -> Addr -> IO Word8)
-  }
-
-newtype Bus = Bus { busComponents :: [Component] }
-
-update :: Word16 -> Bus -> IO Bus
-update t b = Bus <$> forM (busComponents b) \Component{..} -> do
-  s <- compUpdate compState t
-  pure Component { compState = s, ..}
-
-write :: Bus -> Addr -> Word8 -> IO Bus
-write b a v = Bus <$> forM (busComponents b) \c@Component{..} ->
-  if compMatches a
-  then do
-    s <- compWrite compState a v
-    pure Component { compState = s, ..}
-  else pure c
-
-read :: Bus -> Addr -> IO (Maybe Word8)
-read b a = case List.find (`compMatches` a) $ busComponents b of
-  Nothing -> pure Nothing
-  Just Component{..} -> Just <$> compRead compState a
diff --git a/fig-emulator-gb/src/Fig/Emulator/GB/CPU.hs b/fig-emulator-gb/src/Fig/Emulator/GB/CPU.hs
deleted file mode 100644
index 26a00de..0000000
--- a/fig-emulator-gb/src/Fig/Emulator/GB/CPU.hs
+++ /dev/null
@@ -1,692 +0,0 @@
-{-# Language TemplateHaskell #-}
-module Fig.Emulator.GB.CPU
-  ( CPU(..)
-  , Registers(..), initialRegs
-  , Emulating, runEmulating
-  , running, regs, bus, regPC, regSP
-  , regA, regB, regC, regD, regE, regH, regL
-  , regFlagZ, regFlagN, regFlagH, regFlagC
-  , updateComps
-  , decode
-  , step
-  ) where
-
-import Control.Lens.TH (makeLenses)
-
-import Fig.Prelude
-
-import Control.Lens ((.=), use, (^.))
-import Control.Monad (when)
-import Control.Monad.State.Strict (StateT(..))
-
-import Data.Word (Word8, Word16, Word32)
-import Data.Int (Int8)
-import Data.Bits
-
-import Fig.Emulator.GB.Utils
-import Fig.Emulator.GB.Bus (Bus(..), Addr(..))
-import qualified Fig.Emulator.GB.Bus as Bus
-import Fig.Emulator.GB.CPU.Instruction
-
-newtype CPUError = CPUError Text
-  deriving Show
-instance Exception CPUError
-instance Pretty CPUError where
-  pretty (CPUError b) = mconcat
-    [ "CPU error: "
-    , b
-    ]
-
-data Registers = Registers
-  { _regA :: !Word8
-  , _regB :: !Word8, _regC :: !Word8
-  , _regD :: !Word8, _regE :: !Word8
-  , _regH :: !Word8, _regL :: !Word8
-  , _regSP :: !Word16
-  , _regPC :: !Word16
-  , _regFlagZ :: !Bool, _regFlagC :: !Bool
-  , _regFlagN :: !Bool, _regFlagH :: !Bool
-  , _regFlagIME :: !Bool
-  }
-makeLenses 'Registers
-
-initialRegs :: Registers
-initialRegs = Registers
-  { _regA = 0x01
-  , _regB = 0x00, _regC = 0x13
-  , _regD = 0x00, _regE = 0xd8
-  , _regH = 0x01, _regL = 0x4d
-  , _regSP = 0xfffe
-  , _regPC = 0x0100
-  , _regFlagZ = True, _regFlagC = True
-  , _regFlagN = False, _regFlagH = True
-  , _regFlagIME = False
-  }
-
-data CPU = CPU
-  { _lastPC :: Word16
-  , _lastIns :: Instruction
-  , _running :: Bool
-  , _regs :: Registers
-  , _bus :: Bus
-  }
-makeLenses 'CPU
-
-newtype Emulating a = Emulating { runEmulating :: StateT CPU IO a }
-  deriving (Functor, Applicative, Monad, MonadIO, MonadState CPU, MonadThrow)
-
--- logCPUState :: Emulating m => m ()
--- logCPUState = do
---   rs <- use regs
---   let pc = rs ^. regPC
---   b <- use bus
---   m0 <- fromJust <$> liftIO (Bus.read b $ Addr pc)
---   m1 <- fromJust <$> liftIO (Bus.read b $ Addr pc + 1)
---   m2 <- fromJust <$> liftIO (Bus.read b $ Addr pc + 2)
---   m3 <- fromJust <$> liftIO (Bus.read b $ Addr pc + 3)
---   liftIO . hPutStrLn ?log $ mconcat 
---     [ "A:", rreg8 $ rs ^. regA
---     , " F:", rreg8 $ flagsw8 (rs ^. regFlagZ) (rs ^. regFlagN) (rs ^. regFlagH) (rs ^. regFlagC)
---     , " B:", rreg8 $ rs ^. regB
---     , " C:", rreg8 $ rs ^. regC
---     , " D:", rreg8 $ rs ^. regD
---     , " E:", rreg8 $ rs ^. regE
---     , " H:", rreg8 $ rs ^. regH
---     , " L:", rreg8 $ rs ^. regL
---     , " SP:", rreg16 $ rs ^. regSP
---     , " PC:", rreg16 pc
---     , " PCMEM:", rreg8 m0, ",", rreg8 m1, ",", rreg8 m2, ",", rreg8 m3
---     ]
---   where
---     rreg8 = pack . Pr.printf "%02X"
---     rreg16 = pack . Pr.printf "%04X"
-
--- | Inform all components that the given number of t-cycles have passed
-updateComps :: Word16 -> Emulating ()
-updateComps t = do
-  b <- use bus
-  b' <- liftIO $ Bus.update t b
-  bus .= b'
-
-decode :: Emulating Instruction
-decode = do
-  updateComps 4
-  b <- use bus
-  pc <- use $ regs . regPC
-  lastPC .= pc
-  (ins, Addr a) <- liftIO $ readInstruction b $ Addr pc
-  lastIns .= ins
-  regs . regPC .= a
-  pure ins
-
-cond :: Cond -> Emulating Bool
-cond CondNz = not <$> use (regs . regFlagZ)
-cond CondZ = use (regs . regFlagZ)
-cond CondNc = not <$> use (regs . regFlagC)
-cond CondC = use (regs . regFlagC)
-
-read8 :: Addr -> Emulating Word8
-read8 a = do
-  updateComps 4
-  b <- use bus
-  pc <- use lastPC
-  ins <- use lastIns
-  liftIO (Bus.read b a) >>= \case
-    Just v -> pure v
-    Nothing -> throwM . CPUError $ mconcat
-      [ "read from unmapped address "
-      , pretty a
-      , " while executing instruction "
-      , tshow ins
-      , " (at "
-      , pretty $ Addr pc
-      , ")"
-      ]
-
-read16 :: Addr -> Emulating Word16
-read16 a = do
-  lo <- read8 a
-  hi <- read8 $ a + 1
-  pure $ w8w8 hi lo
-
-write8 :: Addr -> Word8 -> Emulating ()
-write8 a v = do
-  updateComps 4
-  b <- use bus
-  b' <- liftIO $ Bus.write b a v
-  bus .= b'
-
-write16 :: Addr -> Word16 -> Emulating ()
-write16 a v = do
-  write8 a $ w16lo v
-  write8 (a + 1) $ w16hi v
-
-r8 :: R8 -> Emulating Word8
-r8 R8B = use $ regs . regB
-r8 R8C = use $ regs . regC
-r8 R8D = use $ regs . regD
-r8 R8E = use $ regs . regE
-r8 R8H = use $ regs . regH
-r8 R8L = use $ regs . regL
-r8 R8MemHL = do
-  hl <- r16 R16HL
-  read8 $ Addr hl
-r8 R8A = use $ regs . regA
-
-setR8 :: R8 -> Word8 -> Emulating ()
-setR8 R8B v = regs . regB .= v
-setR8 R8C v = regs . regC .= v
-setR8 R8D v = regs . regD .= v
-setR8 R8E v = regs . regE .= v
-setR8 R8H v = regs . regH .= v
-setR8 R8L v = regs . regL .= v
-setR8 R8MemHL v = do
-  hl <- r16 R16HL
-  write8 (Addr hl) v
-setR8 R8A v = regs . regA .= v
-
-r16 :: R16 -> Emulating Word16
-r16 R16BC = w8w8 <$> r8 R8B <*> r8 R8C
-r16 R16DE = w8w8 <$> r8 R8D <*> r8 R8E
-r16 R16HL = w8w8 <$> r8 R8H <*> r8 R8L
-r16 R16SP = use $ regs . regSP
-
-setR16 :: R16 -> Word16 -> Emulating ()
-setR16 R16BC v = do
-  regs . regB .= w16hi v
-  regs . regC .= w16lo v
-setR16 R16DE v = do
-  regs . regD .= w16hi v
-  regs . regE .= w16lo v
-setR16 R16HL v = do
-  regs . regH .= w16hi v
-  regs . regL .= w16lo v
-setR16 R16SP v = regs . regSP .= v
-
-r16Stk :: R16Stk -> Emulating Word16
-r16Stk R16StkBC = r16 R16BC
-r16Stk R16StkDE = r16 R16DE
-r16Stk R16StkHL = r16 R16HL
-r16Stk R16StkAF = do
-  hi <- r8 R8A
-  z <- use $ regs . regFlagZ
-  n <- use $ regs . regFlagN
-  h <- use $ regs . regFlagH
-  c <- use $ regs . regFlagC
-  pure . w8w8 hi $ flagsw8 z n h c
-
-setR16Stk :: R16Stk -> Word16 -> Emulating ()
-setR16Stk R16StkBC v = setR16 R16BC v
-setR16Stk R16StkDE v = setR16 R16DE v
-setR16Stk R16StkHL v = setR16 R16HL v
-setR16Stk R16StkAF v = do
-  setR8 R8A $ w16hi v
-  let lo = w16lo v
-  regs . regFlagZ .= w8bit 7 lo
-  regs . regFlagN .= w8bit 6 lo
-  regs . regFlagH .= w8bit 5 lo
-  regs . regFlagC .= w8bit 4 lo
-
-r16Mem :: R16Mem -> Emulating Word16
-r16Mem R16MemBC = r16 R16BC
-r16Mem R16MemDE = r16 R16DE
-r16Mem R16MemHLPlus = do
-  hl <- r16 R16HL
-  setR16 R16HL $ hl + 1
-  pure hl
-r16Mem R16MemHLMinus = do
-  hl <- r16 R16HL
-  setR16 R16HL $ hl - 1
-  pure hl
-
-step :: Instruction -> Emulating ()
-step ins = do
-  let
-    sub8 :: (Word16 -> Word16 -> Word16) -> Word8 -> Word8 -> Emulating Word8
-    sub8 op x y = do
-      let res = op (sext x) (sext y)
-      regs . regFlagH .= (w8bits4 3 y > w8bits4 3 x)
-      regs . regFlagC .= (y > x)
-      regs . regFlagZ .= (res .&. 0xff == 0)
-      regs . regFlagN .= True
-      pure $ trunc res
-    bitwise8 :: (Word8 -> Word8 -> Word8) -> Word8 -> Word8 -> Emulating Word8
-    bitwise8 op x y = do
-      let res = op x y
-      regs . regFlagH .= False
-      regs . regFlagC .= False
-      regs . regFlagZ .= (res .&. 0xff == 0)
-      regs . regFlagN .= False
-      pure res
-  case ins of
-    Nop -> {-# SCC "Nop" #-} pure ()
-    LdR16Imm16 r (Imm16 i) -> {-# SCC "LdR16Imm16" #-} setR16 r i
-    LdR16MemA r -> {-# SCC "LdR16MemA" #-} do
-      addr <- r16Mem r
-      a <- r8 R8A
-      write8 (Addr addr) a
-    LdAR16Mem r -> {-# SCC "LdAR16Mem" #-} do
-      addr <- r16Mem r
-      v <- read8 $ Addr addr
-      setR8 R8A v
-    LdImm16Sp (Imm16 addr) -> {-# SCC "LdImm16Sp" #-} do
-      sp <- r16 R16SP
-      write8 (Addr addr) $ w16lo sp
-      write8 (Addr addr + 1) $ w16hi sp
-    IncR16 r -> {-# SCC "IncR16" #-} do
-      v <- r16 r
-      setR16 r $ v + 1
-    DecR16 r -> {-# SCC "DecR16" #-} do
-      v <- r16 r
-      setR16 r $ v - 1
-    AddHlR16 r -> {-# SCC "AddHlR16" #-} do
-      x <- r16 R16HL
-      y <- r16 r
-      let
-        resl :: Word32
-        resl = fromIntegral x + fromIntegral y
-        res :: Word16
-        res = fromIntegral resl
-      regs . regFlagH .= (shiftR ((x .&. 0xfff) + (y .&. 0xfff)) 12 .&. 0b1 == 0b1)
-      regs . regFlagC .= (shiftR resl 16 .&. 0b1 == 0b1)
-      regs . regFlagN .= False
-      setR16 R16HL res
-    IncR8 r -> {-# SCC "IncR8" #-} do
-      v <- r8 r
-      let (res, _) = addC False v 1
-      regs . regFlagH .= addH False v 1
-      regs . regFlagZ .= (res == 0)
-      regs . regFlagN .= False
-      setR8 r res
-    DecR8 r -> {-# SCC "DecR8" #-} do
-      v <- r8 r
-      let
-        res :: Word8
-        res = v - 1
-      regs . regFlagH .= subH False v 1
-      regs . regFlagZ .= (res == 0)
-      regs . regFlagN .= True
-      setR8 r res
-    LdR8Imm8 r (Imm8 i) -> {-# SCC "LdR8Imm8" #-} setR8 r i
-    Rlca -> {-# SCC "Rlca" #-} do
-      v <- r8 R8A
-      regs . regFlagH .= False
-      regs . regFlagZ .= False
-      regs . regFlagN .= False
-      regs . regFlagC .= w8bit 7 v
-      setR8 R8A $ rotateL v 1
-    Rrca -> {-# SCC "Rrca" #-} do
-      v <- r8 R8A
-      regs . regFlagH .= False
-      regs . regFlagZ .= False
-      regs . regFlagN .= False
-      regs . regFlagC .= w8bit 0 v
-      setR8 R8A $ rotateR v 1
-    Rla -> {-# SCC "Rla" #-} do
-      v <- r8 R8A
-      c <- use $ regs . regFlagC
-      regs . regFlagH .= False
-      regs . regFlagZ .= False
-      regs . regFlagN .= False
-      regs . regFlagC .= w8bit 7 v
-      setR8 R8A $ shiftL v 1 .|. if c then 1 else 0
-    Rra -> {-# SCC "Rra" #-} do
-      v <- r8 R8A
-      c <- use $ regs . regFlagC
-      regs . regFlagH .= False
-      regs . regFlagZ .= False
-      regs . regFlagN .= False
-      regs . regFlagC .= w8bit 0 v
-      setR8 R8A $ shiftR v 1 .|. if c then 0b10000000 else 0
-    Daa -> {-# SCC "Daa" #-} do
-      v <- r8 R8A
-      halfcarry <- use $ regs . regFlagH
-      carry <- use $ regs . regFlagC
-      subtract <- use $ regs . regFlagN
-      let
-        o0 :: Word8
-        o0 = if (not subtract && v .&. 0xf > 0x09) || halfcarry then 0x06 else 0x00
-        c = (not subtract && v > 0x99) || carry
-        o1 :: Word8
-        o1 = if c then o0 .|. 0x60 else o0
-        res = if subtract then v - o1 else v + o1
-      regs . regA .= res
-      regs . regFlagH .= False
-      regs . regFlagZ .= (res == 0)
-      regs . regFlagC .= c
-      pure ()
-    Cpl -> {-# SCC "Cpl" #-} do
-      v <- r8 R8A
-      regs . regFlagH .= True
-      regs . regFlagN .= True
-      setR8 R8A $ complement v
-    Scf -> {-# SCC "Scf" #-} do
-      regs . regFlagH .= False
-      regs . regFlagN .= False
-      regs . regFlagC .= True
-    Ccf -> {-# SCC "Ccf" #-} do
-      c <- use $ regs . regFlagC
-      regs . regFlagH .= False
-      regs . regFlagN .= False
-      regs . regFlagC .= not c
-    JrImm8 (Imm8 i) -> {-# SCC "JrImm8" #-} do
-      pc <- use $ regs . regPC
-      regs . regPC .= pc + sext i
-    JrCondImm8 c (Imm8 i) -> {-# SCC "JrCondImm8" #-} do
-      b <- cond c
-      when b do
-        pc <- use $ regs . regPC
-        regs . regPC .= pc + sext i
-    Stop -> {-# SCC "Stop" #-} unimplemented
-    LdR8R8 dst src -> {-# SCC "LdR8R8" #-} do
-      v <- r8 src
-      setR8 dst v
-    Halt -> {-# SCC "Halt" #-} unimplemented
-    AddAR8 i -> {-# SCC "AddAR8" #-} do
-      x <- r8 R8A
-      y <- r8 i
-      let (res, carry) = addC False x y
-      regs . regFlagH .= addH False x y
-      regs . regFlagC .= carry
-      regs . regFlagZ .= (res .&. 0xff == 0)
-      regs . regFlagN .= False
-      regs . regA .= res
-    AdcAR8 i -> {-# SCC "AdcAR8" #-} do
-      x <- r8 R8A
-      y <- r8 i
-      c <- use $ regs . regFlagC
-      let (res, carry) = addC c x y
-      regs . regFlagH .= addH c x y
-      regs . regFlagC .= carry
-      regs . regFlagZ .= (res .&. 0xff == 0)
-      regs . regFlagN .= False
-      regs . regA .= res
-    SubAR8 i -> {-# SCC "SubAR8" #-} do
-      x <- r8 R8A
-      y <- r8 i
-      let (res, carry) = subC False x y
-      regs . regFlagH .= subH False x y
-      regs . regFlagC .= carry
-      regs . regFlagZ .= (res .&. 0xff == 0)
-      regs . regFlagN .= True
-      regs . regA .= res
-    SbcAR8 i -> {-# SCC "SbcAR8" #-} do
-      x <- r8 R8A
-      y <- r8 i
-      c <- use $ regs . regFlagC
-      let (res, carry) = subC c x y
-      regs . regFlagH .= subH c x y
-      regs . regFlagC .= carry
-      regs . regFlagZ .= (res .&. 0xff == 0)
-      regs . regFlagN .= True
-      regs . regA .= res
-    AndAR8 i -> {-# SCC "AndAR8" #-} do
-      x <- r8 R8A
-      y <- r8 i
-      res <- bitwise8 (.&.) x y
-      regs . regFlagH .= True
-      regs . regA .= res
-    XorAR8 i -> {-# SCC "XorAR8" #-} do
-      x <- r8 R8A
-      y <- r8 i
-      res <- bitwise8 xor x y
-      regs . regA .= res
-    OrAR8 i -> {-# SCC "OrAR8" #-} do
-      x <- r8 R8A
-      y <- r8 i
-      res <- bitwise8 (.|.) x y
-      regs . regA .= res
-    CpAR8 i -> {-# SCC "CpAR8" #-} do
-      x <- r8 R8A
-      y <- r8 i
-      let (res, carry) = subC False x y
-      regs . regFlagH .= subH False x y
-      regs . regFlagC .= carry
-      regs . regFlagZ .= (res .&. 0xff == 0)
-      regs . regFlagN .= True
-    AddAImm8 (Imm8 y) -> {-# SCC "AddAImm8" #-} do
-      x <- r8 R8A
-      let (res, carry) = addC False x y
-      regs . regFlagH .= addH False x y
-      regs . regFlagC .= carry
-      regs . regFlagZ .= (res .&. 0xff == 0)
-      regs . regFlagN .= False
-      regs . regA .= res
-    AdcAImm8 (Imm8 y) -> {-# SCC "AdcAImm8" #-} do
-      x <- r8 R8A
-      c <- use $ regs . regFlagC
-      let (res, carry) = addC c x y
-      regs . regFlagH .= addH c x y
-      regs . regFlagC .= carry
-      regs . regFlagZ .= (res .&. 0xff == 0)
-      regs . regFlagN .= False
-      regs . regA .= res
-    SubAImm8 (Imm8 y) -> {-# SCC "SubAImm8" #-} do
-      x <- r8 R8A
-      let (res, carry) = subC False x y
-      regs . regFlagH .= subH False x y
-      regs . regFlagC .= carry
-      regs . regFlagZ .= (res .&. 0xff == 0)
-      regs . regFlagN .= True
-      regs . regA .= res
-    SbcAImm8 (Imm8 y) -> {-# SCC "SbcAImm8" #-} do
-      x <- r8 R8A
-      c <- use $ regs . regFlagC
-      let (res, carry) = subC c x y
-      regs . regFlagH .= subH c x y
-      regs . regFlagC .= carry
-      regs . regFlagZ .= (res .&. 0xff == 0)
-      regs . regFlagN .= True
-      regs . regA .= res
-    AndAImm8 (Imm8 y) -> {-# SCC "AndAImm8" #-} do
-      x <- r8 R8A
-      res <- bitwise8 (.&.) x y
-      regs . regFlagH .= True
-      regs . regA .= res
-    XorAImm8 (Imm8 y) -> {-# SCC "XorAImm8" #-} do
-      x <- r8 R8A
-      res <- bitwise8 xor x y
-      regs . regA .= res
-    OrAImm8 (Imm8 y) -> {-# SCC "OrAImm8" #-} do
-      x <- r8 R8A
-      res <- bitwise8 (.|.) x y
-      regs . regA .= res
-    CpAImm8 (Imm8 y) -> {-# SCC "CpAImm8" #-} do
-      x <- r8 R8A
-      void $ sub8 (-) x y
-    RetCond c -> {-# SCC "RetCond" #-} do
-      b <- cond c
-      when b do
-        sp <- r16 R16SP
-        v <- read16 $ Addr sp
-        setR16 R16SP $ sp + 2
-        regs . regPC .= v
-    Ret -> {-# SCC "Ret" #-} do
-      sp <- r16 R16SP
-      v <- read16 $ Addr sp
-      setR16 R16SP $ sp + 2
-      regs . regPC .= v
-    Reti -> {-# SCC "Reti" #-} do
-      regs . regFlagIME .= True
-      sp <- r16 R16SP
-      v <- read16 $ Addr sp
-      setR16 R16SP $ sp + 2
-      regs . regPC .= v
-    JpCondImm16 c (Imm16 i) -> {-# SCC "JpCondImm16" #-} do
-      b <- cond c
-      when b do
-        regs . regPC .= i
-    JpImm16 (Imm16 i) -> {-# SCC "JpImm16" #-} do
-      regs . regPC .= i
-    JpHl -> {-# SCC "JpHl" #-} do
-      hl <- r16 R16HL
-      regs . regPC .= hl
-    CallCondImm16 c (Imm16 i) -> {-# SCC "CallCondImm16" #-} do
-      b <- cond c
-      when b do
-        next <- use $ regs . regPC
-        sp <- (\x -> x - 2) <$> r16 R16SP
-        setR16 R16SP sp
-        write16 (Addr sp) next
-        regs . regPC .= i
-    CallImm16 (Imm16 i) -> {-# SCC "CallImm16" #-} do
-      next <- use $ regs . regPC
-      sp <- (\x -> x - 2) <$> r16 R16SP
-      setR16 R16SP sp
-      write16 (Addr sp) next
-      regs . regPC .= i
-    RstTgt3 (Tgt3 v) -> {-# SCC "RstTgt3" #-} do
-      next <- use $ regs . regPC
-      sp <- (\x -> x - 2) <$> r16 R16SP
-      setR16 R16SP sp
-      write16 (Addr sp) next
-      regs . regPC .= shiftL (fromIntegral v) 3
-    PopR16Stk r -> {-# SCC "PopR16Stk" #-} do
-      sp <- r16 R16SP
-      v <- read16 $ Addr sp
-      setR16 R16SP $ sp + 2
-      setR16Stk r v
-    PushR16Stk r -> {-# SCC "PushR16Stk" #-} do
-      sp <- (\x -> x - 2) <$> r16 R16SP
-      v <- r16Stk r
-      setR16 R16SP sp
-      write16 (Addr sp) v
-    LdhCA -> {-# SCC "LdhCA" #-} do
-      c <- r8 R8C
-      a <- r8 R8A
-      write8 (Addr $ 0xff00 + zext c) a
-    LdhImm8A (Imm8 i) -> {-# SCC "LdhImm8A" #-} do
-      a <- r8 R8A
-      write8 (Addr $ 0xff00 + zext i) a
-    LdImm16A (Imm16 i) -> {-# SCC "LdImm16A" #-} do
-      a <- r8 R8A
-      write8 (Addr i) a
-    LdhAC -> {-# SCC "LdhAC" #-} do
-      c <- r8 R8C
-      v <- read8 (Addr $ 0xff00 + zext c)
-      setR8 R8A v
-    LdhAImm8 (Imm8 i) -> {-# SCC "LdhAImm8" #-} do
-      v <- read8 (Addr $ 0xff00 + zext i)
-      setR8 R8A v
-    LdAImm16 (Imm16 i) -> {-# SCC "LdAImm16" #-} do
-      v <- read8 (Addr i)
-      setR8 R8A v
-    AddSpImm8 (Imm8 y) -> {-# SCC "AddSpImm8" #-} do
-      x <- r16 R16SP
-      let
-        res :: Word16
-        res = x + sext y
-        (_, carry) = addC False (w16lo x) y
-      regs . regFlagH .= addH False (w16lo x) y
-      regs . regFlagC .= carry
-      regs . regFlagZ .= False
-      regs . regFlagN .= False
-      setR16 R16SP res
-    LdHlSpPlusImm8 (Imm8 y) -> {-# SCC "LdHlSpPlusImm8" #-} do
-      x <- r16 R16SP
-      let
-        res :: Word16
-        res = x + sext y
-        (_, carry) = addC False (w16lo x) y
-      regs . regFlagH .= addH False (w16lo x) y
-      regs . regFlagC .= carry
-      regs . regFlagZ .= False
-      regs . regFlagN .= False
-      setR16 R16HL res
-    LdSpHl -> {-# SCC "LdSpHl" #-} do
-      v <- r16 R16HL
-      setR16 R16SP v
-    Di -> {-# SCC "Di" #-} regs . regFlagIME .= False
-    Ei -> {-# SCC "Ei" #-} regs . regFlagIME .= True
-    CbRlcR8 r -> {-# SCC "CbRlcR8" #-} do
-      v <- r8 r
-      let res = rotateL v 1
-      regs . regFlagH .= False
-      regs . regFlagZ .= (res == 0)
-      regs . regFlagN .= False
-      regs . regFlagC .= w8bit 7 v
-      setR8 r res
-    CbRrcR8 r -> {-# SCC "CbRrcR8" #-} do
-      v <- r8 r
-      let res = rotateR v 1
-      regs . regFlagH .= False
-      regs . regFlagZ .= (res == 0)
-      regs . regFlagN .= False
-      regs . regFlagC .= w8bit 0 v
-      setR8 r res
-    CbRlR8 r -> {-# SCC "CbRlR8" #-} do
-      v <- r8 r
-      c <- use $ regs . regFlagC
-      let res = shiftL v 1 .|. if c then 0b1 else 0
-      regs . regFlagH .= False
-      regs . regFlagZ .= (res == 0)
-      regs . regFlagN .= False
-      regs . regFlagC .= w8bit 7 v
-      setR8 r res
-    CbRrR8 r -> {-# SCC "CbRrR8" #-} do
-      v <- r8 r
-      c <- use $ regs . regFlagC
-      let rizz = shiftR v 1 .|. if c then 0b10000000 else 0
-      regs . regFlagH .= False
-      regs . regFlagZ .= (rizz == 0)
-      regs . regFlagN .= False
-      regs . regFlagC .= w8bit 0 v
-      setR8 r rizz
-    CbSlaR8 r -> {-# SCC "CbSlaR8" #-} do
-      v <- r8 r
-      let res = shiftL v 1
-      regs . regFlagZ .= (res == 0)
-      regs . regFlagH .= False
-      regs . regFlagN .= False
-      regs . regFlagC .= w8bit 7 v
-      setR8 r res
-    CbSraR8 r -> {-# SCC "CbSraR8" #-} do
-      v <- r8 r
-      let
-        vs :: Int8
-        vs = fromIntegral v
-        ress = shiftR vs 1
-        res :: Word8
-        res = fromIntegral ress
-      regs . regFlagZ .= (res == 0)
-      regs . regFlagH .= False
-      regs . regFlagN .= False
-      regs . regFlagC .= w8bit 0 v
-      setR8 r res
-    CbSwapR8 r -> {-# SCC "CbSwapR8" #-} do
-      v <- r8 r
-      let res = rotate v 4
-      regs . regFlagZ .= (res == 0)
-      regs . regFlagH .= False
-      regs . regFlagN .= False
-      regs . regFlagC .= False
-      setR8 r res
-    CbSrlR8 r -> {-# SCC "CbSrlR8" #-} do
-      v <- r8 r
-      let res = shiftR v 1
-      regs . regFlagZ .= (res == 0)
-      regs . regFlagH .= False
-      regs . regFlagN .= False
-      regs . regFlagC .= w8bit 0 v
-      setR8 r res
-    CbBitB3R8 (B3 idx) r -> {-# SCC "CbBitB3R8" #-} do
-      v <- r8 r
-      regs . regFlagH .= True
-      regs . regFlagN .= False
-      regs . regFlagZ .= not (w8bit idx v)
-    CbResB3R8 (B3 idx) r -> {-# SCC "CbResB3R8" #-} do
-      v <- r8 r
-      setR8 r $ v .&. (0xff .^. shiftL 0b1 idx)
-    CbSetB3R8 (B3 idx) r -> {-# SCC "CbSetB3R8" #-} do
-      v <- r8 r
-      setR8 r $ v .|. shiftL 0b1 idx
-  where
-    unimplemented :: Emulating ()
-    unimplemented = do
-      a <- use lastPC
-      throwM . CPUError $ mconcat
-        [ "unimplemented instruction (at "
-        , pretty $ Addr a
-        , "): "
-        , tshow ins
-        ]
diff --git a/fig-emulator-gb/src/Fig/Emulator/GB/CPU/Instruction.hs b/fig-emulator-gb/src/Fig/Emulator/GB/CPU/Instruction.hs
deleted file mode 100644
index 002d4e0..0000000
--- a/fig-emulator-gb/src/Fig/Emulator/GB/CPU/Instruction.hs
+++ /dev/null
@@ -1,342 +0,0 @@
-module Fig.Emulator.GB.CPU.Instruction where
-
-import Fig.Prelude
-import Prelude (Integral, fromIntegral, error)
-
-import Data.Word (Word8, Word16)
-
-import Fig.Emulator.GB.Utils
-import Fig.Emulator.GB.Bus as Bus
-
-newtype DecodeError = DecodeError Text
-  deriving Show
-instance Exception DecodeError
-instance Pretty DecodeError where
-  pretty (DecodeError b) = mconcat
-    [ "instruction decoding error: "
-    , b
-    ]
-
-class ExtractFromOpcode t where
-  ext :: Integral i => i -> t
-
-data R8 = R8B | R8C | R8D | R8E | R8H | R8L | R8MemHL | R8A
-  deriving (Show)
-instance ExtractFromOpcode R8 where
-  ext i = case (fromIntegral i :: Int) of
-    0 -> R8B
-    1 -> R8C
-    2 -> R8D
-    3 -> R8E
-    4 -> R8H
-    5 -> R8L
-    6 -> R8MemHL
-    7 -> R8A
-    _ -> error "unreachable"
-
-data R16 = R16BC | R16DE | R16HL | R16SP
-  deriving (Show)
-instance ExtractFromOpcode R16 where
-  ext i = case (fromIntegral i :: Int) of
-    0 -> R16BC
-    1 -> R16DE
-    2 -> R16HL
-    3 -> R16SP
-    _ -> error "unreachable"
-
-data R16Stk = R16StkBC | R16StkDE | R16StkHL | R16StkAF
-  deriving (Show)
-instance ExtractFromOpcode R16Stk where
-  ext i = case (fromIntegral i :: Int) of
-    0 -> R16StkBC
-    1 -> R16StkDE
-    2 -> R16StkHL
-    3 -> R16StkAF
-    _ -> error "unreachable"
-
-data R16Mem = R16MemBC | R16MemDE | R16MemHLPlus | R16MemHLMinus
-  deriving (Show)
-instance ExtractFromOpcode R16Mem where
-  ext i = case (fromIntegral i :: Int) of
-    0 -> R16MemBC
-    1 -> R16MemDE
-    2 -> R16MemHLPlus
-    3 -> R16MemHLMinus
-    _ -> error "unreachable"
-
-data Cond = CondNz | CondZ | CondNc | CondC
-  deriving (Show)
-instance ExtractFromOpcode Cond where
-  ext i = case (fromIntegral i :: Int) of
-    0 -> CondNz
-    1 -> CondZ
-    2 -> CondNc
-    3 -> CondC
-    _ -> error "unreachable"
-
-newtype B3 = B3 Int
-  deriving (Show)
-instance ExtractFromOpcode B3 where
-  ext i = B3 $ fromIntegral i
-
-newtype Tgt3 = Tgt3 Int
-  deriving (Show)
-instance ExtractFromOpcode Tgt3 where
-  ext i = Tgt3 $ fromIntegral i
-
-newtype Imm8 = Imm8 Word8
-  deriving (Show)
-readImm8 :: Bus.Bus -> Addr -> IO Imm8
-readImm8 b a = Bus.read b a >>= \case
-  Just i -> pure $ Imm8 i
-  Nothing -> throwM . DecodeError $ mconcat
-    [ "failed to read immediate at unmapped address"
-    , pretty a
-    ]
-
-newtype Imm16 = Imm16 Word16
-  deriving (Show)
-readImm16 :: Bus.Bus -> Addr -> IO Imm16
-readImm16 b a = do
-  mlo <- Bus.read b a
-  mhi <- Bus.read b $ a + 1
-  case (mlo, mhi) of
-    (Just lo, Just hi) -> pure . Imm16 $ w8w8 hi lo
-    _otherwise -> throwM . DecodeError $ mconcat
-      [ "failed to read 16-bit immediate at unmapped address"
-      , pretty a
-      ]
-
-data Instruction
-  -- Block 0
-  = Nop
-
-  | LdR16Imm16 !R16 !Imm16
-  | LdR16MemA !R16Mem
-  | LdAR16Mem !R16Mem
-  | LdImm16Sp !Imm16
-
-  | IncR16 !R16
-  | DecR16 !R16
-  | AddHlR16 !R16
-
-  | IncR8 !R8
-  | DecR8 !R8
-
-  | LdR8Imm8 !R8 !Imm8
-
-  | Rlca
-  | Rrca
-  | Rla
-  | Rra
-  | Daa
-  | Cpl
-  | Scf
-  | Ccf
-
-  | JrImm8 !Imm8
-  | JrCondImm8 !Cond !Imm8
-
-  | Stop
-
-  -- Block 1
-  | LdR8R8 !R8 !R8
-
-  | Halt
-
-  -- Block 2
-  | AddAR8 !R8
-  | AdcAR8 !R8
-  | SubAR8 !R8
-  | SbcAR8 !R8
-  | AndAR8 !R8
-  | XorAR8 !R8
-  | OrAR8 !R8
-  | CpAR8 !R8
-
-  -- Block 3
-  | AddAImm8 !Imm8
-  | AdcAImm8 !Imm8
-  | SubAImm8 !Imm8
-  | SbcAImm8 !Imm8
-  | AndAImm8 !Imm8
-  | XorAImm8 !Imm8
-  | OrAImm8 !Imm8
-  | CpAImm8 !Imm8
-
-  | RetCond !Cond
-  | Ret
-  | Reti
-  | JpCondImm16 !Cond !Imm16
-  | JpImm16 !Imm16
-  | JpHl
-  | CallCondImm16 !Cond !Imm16
-  | CallImm16 !Imm16
-  | RstTgt3 !Tgt3
-
-  | PopR16Stk !R16Stk
-  | PushR16Stk !R16Stk
-
-  | LdhCA
-  | LdhImm8A !Imm8
-  | LdImm16A !Imm16
-  | LdhAC
-  | LdhAImm8 !Imm8
-  | LdAImm16 !Imm16
-
-  | AddSpImm8 !Imm8
-  | LdHlSpPlusImm8 !Imm8
-  | LdSpHl
-
-  | Di
-  | Ei
-
-  -- 0xcb prefixed 16-bit instructions
-  | CbRlcR8 !R8
-  | CbRrcR8 !R8
-  | CbRlR8 !R8
-  | CbRrR8 !R8
-  | CbSlaR8 !R8
-  | CbSraR8 !R8
-  | CbSwapR8 !R8
-  | CbSrlR8 !R8
-
-  | CbBitB3R8 !B3 !R8
-  | CbResB3R8 !B3 !R8
-  | CbSetB3R8 !B3 !R8
-  deriving (Show)
-
-readInstruction ::
-  Bus.Bus -> Addr ->
-  IO (Instruction, Addr)
-readInstruction b a = do
-  op <- Bus.read b a >>= \case
-    Just o -> pure o
-    Nothing -> throwM . DecodeError $ mconcat
-      [ "failed to read opcode at unmapped address "
-      , pretty a
-      ]
-  let blk = w8bits2 7 op
-  let bot3 = w8bits3 2 op
-  let bot4 = w8bits4 3 op
-  let no i = pure (i, a + 1)
-  let imm8 f = do
-        x <- readImm8 b $ a + 1
-        pure (f x, a + 2)
-  let imm16 f = do
-        x <- readImm16 b $ a + 1
-        pure (f x, a + 3)
-  case (op, blk, bot4, bot3) of
-    -- Block 0
-    (0b00000000, _, _, _) -> {-# SCC "DecodeNop" #-} no Nop
-
-    (_, 0b00, 0b0001, _) -> {-# SCC "DecodeLdR16Imm16" #-} imm16 $ LdR16Imm16 (ext $ w8bits2 5 op)
-    (_, 0b00, 0b0010, _) -> {-# SCC "DecodeLdR16MemA" #-} no $ LdR16MemA (ext $ w8bits2 5 op)
-    (_, 0b00, 0b1010, _) -> {-# SCC "DecodeLdAR16Mem" #-} no $ LdAR16Mem (ext $ w8bits2 5 op)
-    (0b00001000, _, _, _) -> {-# SCC "DecodeLdImm16Sp" #-} imm16 LdImm16Sp
-
-    (_, 0b00, 0b0011, _) -> {-# SCC "DecodeIncR16" #-} no $ IncR16 (ext $ w8bits2 5 op)
-    (_, 0b00, 0b1011, _) -> {-# SCC "DecodeDecR16" #-} no $ DecR16 (ext $ w8bits2 5 op)
-    (_, 0b00, 0b1001, _) -> {-# SCC "DecodeAddHlR16" #-} no $ AddHlR16 (ext $ w8bits2 5 op)
-
-    (_, 0b00, _, 0b100) -> {-# SCC "DecodeIncR8" #-} no $ IncR8 (ext $ w8bits3 5 op)
-    (_, 0b00, _, 0b101) -> {-# SCC "DecodeDecR8" #-} no $ DecR8 (ext $ w8bits3 5 op)
-
-    (_, 0b00, _, 0b110) -> {-# SCC "DecodeLdR8Imm8" #-} imm8 $ LdR8Imm8 (ext $ w8bits3 5 op)
-
-    (0b00000111, _, _, _) -> {-# SCC "DecodeRlca" #-} no Rlca
-    (0b00001111, _, _, _) -> {-# SCC "DecodeRrca" #-} no Rrca
-    (0b00010111, _, _, _) -> {-# SCC "DecodeRla" #-} no Rla
-    (0b00011111, _, _, _) -> {-# SCC "DecodeRra" #-} no Rra
-    (0b00100111, _, _, _) -> {-# SCC "DecodeDaa" #-} no Daa
-    (0b00101111, _, _, _) -> {-# SCC "DecodeCpl" #-} no Cpl
-    (0b00110111, _, _, _) -> {-# SCC "DecodeScf" #-} no Scf
-    (0b00111111, _, _, _) -> {-# SCC "DecodeCcf" #-} no Ccf
-
-    (0b00011000, _, _, _) -> {-# SCC "DecodeJrImm8" #-} imm8 JrImm8
-    (0b00010000, _, _, _) -> {-# SCC "DecodeStop" #-} no Stop
-    (_, 0b00, _, 0b000) -> {-# SCC "DecodeJrCondImm8" #-} imm8 $ JrCondImm8 (ext $ w8bits2 4 op)
-
-    -- Block 1
-    (0b01110110, _, _, _) -> {-# SCC "DecodeHalt" #-} no Halt
-    (_, 0b01, _, _) -> {-# SCC "DecodeLdR8R8" #-} no $ LdR8R8 (ext $ w8bits3 5 op) (ext $ w8bits3 2 op)
-
-    -- Block 2
-    (_, 0b10, _, _) -> do
-      let ins = case w8bits3 5 op of
-            0b000 -> {-# SCC "DecodeAddAR8" #-} AddAR8
-            0b001 -> {-# SCC "DecodeAdcAR8" #-} AdcAR8
-            0b010 -> {-# SCC "DecodeSubAR8" #-} SubAR8
-            0b011 -> {-# SCC "DecodeSbcAR8" #-} SbcAR8
-            0b100 -> {-# SCC "DecodeAndAR8" #-} AndAR8
-            0b101 -> {-# SCC "DecodeXorAR8" #-} XorAR8
-            0b110 -> {-# SCC "DecodeOrAR8" #-} OrAR8
-            0b111 -> {-# SCC "DecodeCpAR8" #-} CpAR8
-            _ -> error "unreachable"
-      no $ ins (ext $ w8bits3 2 op)
-
-    -- Block 3
-    (0b11000110, _, _, _) -> {-# SCC "DecodeAddAImm8" #-} imm8 AddAImm8
-    (0b11001110, _, _, _) -> {-# SCC "DecodeAdcAImm8" #-} imm8 AdcAImm8
-    (0b11010110, _, _, _) -> {-# SCC "DecodeSubAImm8" #-} imm8 SubAImm8
-    (0b11011110, _, _, _) -> {-# SCC "DecodeSbcAImm8" #-} imm8 SbcAImm8
-    (0b11100110, _, _, _) -> {-# SCC "DecodeAndAImm8" #-} imm8 AndAImm8
-    (0b11101110, _, _, _) -> {-# SCC "DecodeXorAImm8" #-} imm8 XorAImm8
-    (0b11110110, _, _, _) -> {-# SCC "DecodeOrAImm8" #-} imm8 OrAImm8
-    (0b11111110, _, _, _) -> {-# SCC "DecodeCpAImm8" #-} imm8 CpAImm8
-
-    (0b11001001, _, _, _) -> {-# SCC "DecodeRet" #-} no Ret
-    (0b11011001, _, _, _) -> {-# SCC "DecodeReti" #-} no Reti
-    (0b11000011, _, _, _) -> {-# SCC "DecodeJpImm16" #-} imm16 JpImm16
-    (0b11101001, _, _, _) -> {-# SCC "DecodeJpHl" #-} no JpHl
-    (0b11001101, _, _, _) -> {-# SCC "DecodeCallImm16" #-} imm16 CallImm16
-
-    (0b11100010, _, _, _) -> {-# SCC "DecodeLdhCA" #-} no LdhCA
-    (0b11100000, _, _, _) -> {-# SCC "DecodeLdhImm8A" #-} imm8 LdhImm8A
-    (0b11101010, _, _, _) -> {-# SCC "DecodeLdImm16A" #-} imm16 LdImm16A
-    (0b11110010, _, _, _) -> {-# SCC "DecodeLdhAC" #-} no LdhAC
-    (0b11110000, _, _, _) -> {-# SCC "DecodeLdhAImm8" #-} imm8 LdhAImm8
-    (0b11111010, _, _, _) -> {-# SCC "DecodeLdAImm16" #-} imm16 LdAImm16
-
-    (0b11101000, _, _, _) -> {-# SCC "DecodeAddSpImm8" #-} imm8 AddSpImm8
-    (0b11111000, _, _, _) -> {-# SCC "DecodeLdHlSpPlusImm8" #-} imm8 LdHlSpPlusImm8
-    (0b11111001, _, _, _) -> {-# SCC "DecodeLdSpHl" #-} no LdSpHl
-
-    (0b11110011, _, _, _) -> {-# SCC "DecodeDi" #-} no Di
-    (0b11111011, _, _, _) -> {-# SCC "DecodeEi" #-} no Ei
-
-    (0b11001011, _, _, _) -> {-# SCC "DecodeCBPrefix" #-} do
-      -- 0xcb prefix
-      op2 <- Bus.read b (a + 1) >>= \case
-        Just o -> pure o
-        Nothing -> throwM . DecodeError $ mconcat
-          [ "failed to read (0xCB-prefixed) opcode at unmapped address "
-          , pretty $ a + 1
-          ]
-      case w8bits2 7 op2 of
-
-        0b00 -> case w8bits3 5 op2 of
-          0b000 -> {-# SCC "DecodeCbRlcR8" #-} pure (CbRlcR8 $ ext $ w8bits3 2 op2, a + 2)
-          0b001 -> {-# SCC "DecodeCbRrcR8" #-} pure (CbRrcR8 $ ext $ w8bits3 2 op2, a + 2)
-          0b010 -> {-# SCC "DecodeCbRlR8" #-} pure (CbRlR8 $ ext $ w8bits3 2 op2, a + 2)
-          0b011 -> {-# SCC "DecodeCbRrR8" #-} pure (CbRrR8 $ ext $ w8bits3 2 op2, a + 2)
-          0b100 -> {-# SCC "DecodeCbSlaR8" #-} pure (CbSlaR8 $ ext $ w8bits3 2 op2, a + 2)
-          0b101 -> {-# SCC "DecodeCbSraR8" #-} pure (CbSraR8 $ ext $ w8bits3 2 op2, a + 2)
-          0b110 -> {-# SCC "DecodeCbSwapR8" #-} pure (CbSwapR8 $ ext $ w8bits3 2 op2, a + 2)
-          0b111 -> {-# SCC "DecodeCbSrlR8" #-} pure (CbSrlR8 $ ext $ w8bits3 2 op2, a + 2)
-          _ -> error "unreachable"
-        0b01 -> {-# SCC "DecodeCbBitB3R8" #-} pure (CbBitB3R8 (ext $ w8bits3 5 op2) $ ext $ w8bits3 2 op2, a + 2)
-        0b10 -> {-# SCC "DecodeCbResB3R8" #-} pure (CbResB3R8 (ext $ w8bits3 5 op2) $ ext $ w8bits3 2 op2, a + 2)
-        0b11 -> {-# SCC "DecodeCbSetB3R8" #-} pure (CbSetB3R8 (ext $ w8bits3 5 op2) $ ext $ w8bits3 2 op2, a + 2)
-        _ -> error "unreachable"
-
-    (_, 0b11, _, 0b000) -> {-# SCC "DecodeRetCond" #-} no $ RetCond (ext $ w8bits2 4 op)
-    (_, 0b11, _, 0b010) -> {-# SCC "DecodeJpCondImm16" #-} imm16 $ JpCondImm16 (ext $ w8bits2 4 op)
-    (_, 0b11, _, 0b100) -> {-# SCC "DecodeCallCondImm16" #-} imm16 $ CallCondImm16 (ext $ w8bits2 4 op)
-    (_, 0b11, _, 0b111) -> {-# SCC "DecodeRstTgt3" #-} no $ RstTgt3 (ext $ w8bits3 5 op)
-    (_, 0b11, 0b0001, _) -> {-# SCC "DecodePopR16Stk" #-} no $ PopR16Stk (ext $ w8bits2 5 op)
-    (_, 0b11, 0b0101, _) -> {-# SCC "DecodePushR16Stk" #-} no $ PushR16Stk (ext $ w8bits2 5 op)
-
-    _unknown -> do
-      log $ "unknown opcode: " <> tshow op
-      no Nop
diff --git a/fig-emulator-gb/src/Fig/Emulator/GB/Component/Interrupt.hs b/fig-emulator-gb/src/Fig/Emulator/GB/Component/Interrupt.hs
deleted file mode 100644
index f6ea420..0000000
--- a/fig-emulator-gb/src/Fig/Emulator/GB/Component/Interrupt.hs
+++ /dev/null
@@ -1,33 +0,0 @@
-module Fig.Emulator.GB.Component.Interrupt where
-
-import Fig.Prelude
-
-import Fig.Emulator.GB.Utils
-import Fig.Emulator.GB.Bus
-
-newtype InterruptError = InterruptError Text
-  deriving Show
-instance Exception InterruptError
-instance Pretty InterruptError where
-  pretty (InterruptError b) = mconcat
-    [ "interrupt error: "
-    , b
-    ]
-
-compInterrupt :: Component
-compInterrupt = Component
-  { compState = ()
-  , compMatches = \a -> a == 0xff0f || a == 0xffff
-  , compUpdate = \s _ -> pure s
-  , compWrite = \s (Addr a) v -> do
-      case a of
-        0xff0f -> do
-          -- log $ "set IF:" <> show8 v
-          pure ()
-        0xffff -> do
-          -- log $ "set IE:" <> show8 v
-          pure ()
-        _ -> throwM . InterruptError $ "write to invalid address: " <> pretty (Addr a)
-      pure s
-  , compRead = \_ _ -> pure 0x00
-  }
diff --git a/fig-emulator-gb/src/Fig/Emulator/GB/Component/Joystick.hs b/fig-emulator-gb/src/Fig/Emulator/GB/Component/Joystick.hs
deleted file mode 100644
index 7519ea5..0000000
--- a/fig-emulator-gb/src/Fig/Emulator/GB/Component/Joystick.hs
+++ /dev/null
@@ -1,23 +0,0 @@
-module Fig.Emulator.GB.Component.Joystick where
-
-import Fig.Prelude
-
-import Fig.Emulator.GB.Bus
-
-newtype JoystickError = JoystickError Text
-  deriving Show
-instance Exception JoystickError
-instance Pretty JoystickError where
-  pretty (JoystickError b) = mconcat
-    [ "joystick error: "
-    , b
-    ]
-
-compJoystick :: Component
-compJoystick = Component
-  { compState = ()
-  , compMatches = (== 0xff00)
-  , compUpdate = \s _ -> pure s
-  , compWrite = \s _ _ -> pure s
-  , compRead = \_ _ -> pure 0x00
-  }
diff --git a/fig-emulator-gb/src/Fig/Emulator/GB/Component/Misc.hs b/fig-emulator-gb/src/Fig/Emulator/GB/Component/Misc.hs
deleted file mode 100644
index be15e56..0000000
--- a/fig-emulator-gb/src/Fig/Emulator/GB/Component/Misc.hs
+++ /dev/null
@@ -1,24 +0,0 @@
-module Fig.Emulator.GB.Component.Misc where
-
-import Fig.Prelude
-
-import Fig.Emulator.GB.Utils
-import Fig.Emulator.GB.Bus
-
-newtype MiscError = MiscError Text
-  deriving Show
-instance Exception MiscError
-instance Pretty MiscError where
-  pretty (MiscError b) = mconcat
-    [ "misc component error: "
-    , b
-    ]
-
-compMisc :: Component
-compMisc = Component
-  { compState = ()
-  , compMatches = (== 0xff4d)
-  , compUpdate = \s _ -> pure s
-  , compWrite = \s _ _ -> pure s
-  , compRead = \_ _ -> pure 0x00
-  }
diff --git a/fig-emulator-gb/src/Fig/Emulator/GB/Component/RAM.hs b/fig-emulator-gb/src/Fig/Emulator/GB/Component/RAM.hs
deleted file mode 100644
index 4dc5715..0000000
--- a/fig-emulator-gb/src/Fig/Emulator/GB/Component/RAM.hs
+++ /dev/null
@@ -1,40 +0,0 @@
-module Fig.Emulator.GB.Component.RAM
-  ( compWRAM
-  ) where
-
-import Fig.Prelude
-
-import qualified Data.Vector as V
-import qualified Data.Vector.Mutable as MV
-import Data.Word (Word8)
-
-import Fig.Emulator.GB.Bus
-
-newtype RAMError = RAMError Text
-  deriving Show
-instance Exception RAMError
-instance Pretty RAMError where
-  pretty (RAMError b) = mconcat
-    [ "internal RAM error: "
-    , b
-    ]
-
-compWRAM :: Addr -> Int -> Component
-compWRAM start size = Component
-  { compState = V.replicate size 0 :: V.Vector Word8
-  , compMatches = \a ->
-      a >= start && a <= end
-  , compUpdate = \s _ -> {-# SCC "ComponentWRAMUpdate" #-} pure s
-  , compWrite = \s ad v -> {-# SCC "ComponentWRAMWrite" #-} do
-      let offset = fromIntegral . unAddr $ ad - start
-      pure $ V.modify (\ms -> MV.write ms offset v) s
-  , compRead = \s ad -> {-# SCC "ComponentWRAMRead" #-} do
-      let offset = fromIntegral . unAddr $ ad - start
-      case s V.!? offset of
-        Nothing -> throwM . RAMError $ mconcat
-          [ "address ", pretty ad, " out of bounds"
-          ]
-        Just v -> pure v
-  }
-  where
-    end = start + Addr (fromIntegral (size - 1))
diff --git a/fig-emulator-gb/src/Fig/Emulator/GB/Component/ROM.hs b/fig-emulator-gb/src/Fig/Emulator/GB/Component/ROM.hs
deleted file mode 100644
index 6aafc46..0000000
--- a/fig-emulator-gb/src/Fig/Emulator/GB/Component/ROM.hs
+++ /dev/null
@@ -1,45 +0,0 @@
-module Fig.Emulator.GB.Component.ROM
-  ( compROM
-  ) where
-
-import Fig.Prelude
-import Prelude (fromIntegral)
-
-import qualified Data.Vector as V
-import qualified Data.ByteString as BS
-
-import Fig.Emulator.GB.Bus
-
-newtype ROMError = ROMError Text
-  deriving Show
-instance Exception ROMError
-instance Pretty ROMError where
-  pretty (ROMError b) = mconcat
-    [ "internal ROM error: "
-    , b
-    ]
-
--- | Initialize base ROM (no mapper) from a ByteString
-compROM :: ByteString -> Component
-compROM bs = Component
-  { compState = V.fromList $ BS.unpack bs
-  , compMatches = \a ->
-      a >= start && a < end
-  , compUpdate = \s _ -> pure s
-  , compWrite = \s _ad _v ->
-      pure s
-      -- throwM . ROMError $ mconcat
-      -- [ "tried to write to ROM at ", pretty ad
-      -- ]
-  , compRead = \s ad -> do
-      let offset = fromIntegral . unAddr $ ad - start
-      case s V.!? offset of
-        Nothing -> throwM . ROMError $ mconcat
-          [ "address ", pretty ad, " out of bounds"
-          ]
-        Just v -> pure v
-  }
-  where
-    start = 0x0000
-    -- end = 0x4000
-    end = 0x8000
diff --git a/fig-emulator-gb/src/Fig/Emulator/GB/Component/Serial.hs b/fig-emulator-gb/src/Fig/Emulator/GB/Component/Serial.hs
deleted file mode 100644
index 3912e5d..0000000
--- a/fig-emulator-gb/src/Fig/Emulator/GB/Component/Serial.hs
+++ /dev/null
@@ -1,35 +0,0 @@
-module Fig.Emulator.GB.Component.Serial where
-
-import Fig.Prelude
-
-import GHC.IO.Handle (hPutChar)
-
-import Data.Char (chr)
-
-import Fig.Emulator.GB.Utils
-import Fig.Emulator.GB.Bus
-
-newtype SerialError = SerialError Text
-  deriving Show
-instance Exception SerialError
-instance Pretty SerialError where
-  pretty (SerialError b) = mconcat
-    [ "serial error: "
-    , b
-    ]
-
-compSerial :: Maybe Handle -> Component
-compSerial mh = Component
-  { compState = ()
-  , compMatches = (== 0xff01)
-  , compUpdate = \s _ -> pure s
-  , compWrite = \s _ v -> do
-      log $ mconcat
-        [ "wrote serial byte: ", tshow $ chr $ fromIntegral v
-        ]
-      case mh of
-        Nothing -> pure ()
-        Just h -> liftIO . hPutChar h . chr $ fromIntegral v
-      pure s
-  , compRead = \_ _ -> pure 0x00
-  }
diff --git a/fig-emulator-gb/src/Fig/Emulator/GB/Component/Video.hs b/fig-emulator-gb/src/Fig/Emulator/GB/Component/Video.hs
deleted file mode 100644
index b1ddadc..0000000
--- a/fig-emulator-gb/src/Fig/Emulator/GB/Component/Video.hs
+++ /dev/null
@@ -1,279 +0,0 @@
-module Fig.Emulator.GB.Component.Video where
-
-import Fig.Prelude
-import Prelude (error, ($!))
-
-import qualified Foreign.Ptr as Ptr
-import qualified Foreign.Storable as St
-
-import Control.DeepSeq (force)
-import Control.Monad (unless)
-
-import Data.Word (Word8, Word16, Word32)
-import qualified Data.Vector as V
-import qualified Data.Vector.Mutable as MV
-
-import qualified SDL
-
-import Fig.Emulator.GB.Utils
-import Fig.Emulator.GB.Bus
-
-newtype VideoError = VideoError Text
-  deriving Show
-instance Exception VideoError
-instance Pretty VideoError where
-  pretty (VideoError b) = mconcat
-    [ "video error: "
-    , b
-    ]
-
-screenWidth :: Word16
--- screenWidth = 160
-screenWidth = 8 * 32
-
-screenHeight :: Word16
--- screenHeight = 144
-screenHeight = 8 * 32
-
-newtype Framebuffer = Framebuffer
-  { fbSurface :: SDL.Surface
-  }
-
-initializeFramebuffer :: IO Framebuffer
-initializeFramebuffer = do
-  s <- liftIO $ SDL.createRGBSurface
-    (SDL.V2 (fromIntegral screenWidth) $ fromIntegral screenHeight)
-    SDL.RGBA8888
-  pure Framebuffer
-    { fbSurface = s
-    }
-
-
-logTilemap :: V.Vector Word8 -> IO ()
-logTilemap v = do
-  let base = 0x9800 - 0x8000
-  bytes <- forM ([0..(32 * 32)] :: [Int]) \i -> do
-    case v V.!? (base + i) of
-      Nothing -> error "unreachable"
-      Just a -> pure a
-  log $ "tilemap:" <> tshow bytes
-
-blitPixel :: Word32 -> (Word8, Word8) -> Framebuffer -> IO ()
-blitPixel c (x, y) fb = do
-  SDL.lockSurface $ fbSurface fb
-  (base :: Ptr.Ptr Word32) <- Ptr.castPtr <$> SDL.surfacePixels (fbSurface fb)
-  let p = Ptr.plusPtr base
-        $ 4
-        * (fromIntegral y * fromIntegral screenWidth + fromIntegral x)
-  liftIO $ St.poke p c
-  SDL.unlockSurface $ fbSurface fb
-
-blitTile :: Int -> V.Vector Word8 -> Int -> (Word8, Word8) -> Framebuffer -> IO ()
-blitTile base v num (bx, by) fb = do
-  let a = num * 16
-  log "start"
-  (ps :: [(Word8, Word8, Word8)]) <- mconcat <$> forM [0..7] \y -> do
-    mconcat <$> forM [0..1] \xb -> do
-      b <- case v V.!? fromIntegral (base + a + (y * 2 + xb)) of
-        Just b -> pure b
-        Nothing -> throwM . VideoError $ mconcat
-          [ "tile offset ", pretty . Addr $ fromIntegral a
-          , " out of bounds"
-          ]
-      log $ show8 b
-      pure
-        [ (bx + fromIntegral xb, by + fromIntegral y, w8bits2 7 b)
-        , (bx + fromIntegral xb + 1, by + fromIntegral y, w8bits2 5 b)
-        , (bx + fromIntegral xb + 2, by + fromIntegral y, w8bits2 3 b)
-        , (bx + fromIntegral xb + 3, by + fromIntegral y, w8bits2 1 b)
-        ]
-  forM_ ps \(x, y, p) -> do
-    unless (p == 0) do
-      blitPixel
-        (case p of
-           0x01 -> 0xff0000ff
-           0x02 -> 0x00ff00ff
-           0x03 -> 0x0000ffff
-           _else -> error "unreachable"
-        )
-        (x, y) fb
-
-readTileMap :: Int -> V.Vector Word8 -> IO [(Int, Int, Word8)]
-readTileMap base vram = do
-  mconcat <$> forM ([0..32] :: [Int]) \x -> do
-    forM ([0..32] :: [Int]) \y -> do
-      case vram V.!? (base + y * 32 + x) of
-        Nothing -> error "unreachable"
-        Just a -> pure (x, y, a)
-
-data VideoAddrRange
-  = VideoAddrVRAM !Addr
-  | VideoAddrStatus !Addr
-  deriving Show
-
-videoAddrRange :: Addr -> Maybe VideoAddrRange
-videoAddrRange a = if
-  | a >= 0x8000 && a < 0xa000 -> Just . VideoAddrVRAM $ a - 0x8000
-  | a >= 0xff40 && a <= 0xff4b -> Just . VideoAddrStatus $ a - 0xff40
-  | otherwise -> Nothing
-
-data RenderState
-  = RenderOAMSearch
-  | RenderPixelTransfer
-  | RenderHBlank
-  | RenderVBlank
-  deriving Show
-
-data VideoState = VideoState
-  { vstFb :: !Framebuffer
-  , vstVRAM :: !(V.Vector Word8)
-  , vstLcdc :: !Word8
-  , vstScx :: !Word8
-  , vstScy :: !Word8
-  , vstLy :: !Word8
-  , vstLx :: !Word8
-  , vstRenderState :: !RenderState
-  , vstTick :: !Word16
-  }
-
-compVideo :: Framebuffer -> Component
-compVideo framebuffer = Component
-  { compState = VideoState
-    { vstFb = framebuffer
-    , vstVRAM = V.replicate (8 * 1024) 0
-    , vstLcdc = 0
-    , vstScx = 0
-    , vstScy = 0
-    , vstLy = 0
-    , vstLx = 0
-    , vstRenderState = RenderOAMSearch
-    , vstTick = 0
-    }
-
-  , compMatches = isJust  . videoAddrRange
-
-  , compUpdate = \s t -> {-# SCC "ComponentVideoUpdate" #-} do
-      let tick = vstTick s + t
-      let ly = vstLy s + 1
-      case vstRenderState s of
-        RenderOAMSearch
-          | tick == 40 -> pure $! s
-            { vstTick = tick
-            , vstRenderState = RenderPixelTransfer
-            }
-          | otherwise -> pure $! s
-            { vstTick = tick
-            }
-        RenderPixelTransfer
-          | tick == 200 -> pure $! s
-            { vstTick = tick
-            , vstRenderState = RenderHBlank
-            }
-          | otherwise -> pure $! s
-            { vstTick = tick
-            }
-        RenderHBlank
-          | tick == 456 -> do
-              if ly == 144
-                then
-                pure $! s
-                { vstTick = 0
-                , vstLy = ly
-                , vstRenderState = RenderVBlank
-                }
-                else
-                pure $! s
-                { vstTick = 0
-                , vstLy = ly
-                , vstRenderState = RenderOAMSearch
-                }
-          | otherwise -> pure $! s
-            { vstTick = tick
-            }
-        RenderVBlank
-          | tick == 456 -> do
-              if ly == 153
-                then do
-                -- log "vblank"
-                -- logTilemap $ vstVRAM s
-                let bgmapbase = (if w8bit 3 $ vstLcdc s then 0x9c00 else 0x9800) - 0x8000
-                let bgbase = (if w8bit 4 $ vstLcdc s then 0x8000 else 0x9000) - 0x8000
-                tiles <- readTileMap bgmapbase (vstVRAM s)
-                blitTile 0 (vstVRAM s) 48 (0, 8) $ vstFb s
-                -- forM_ tiles \(x, y, tile) -> do
-                --   blitTile bgbase (vstVRAM s)
-                --     (fromIntegral $ tile * 16)
-                --     (fromIntegral x * 8, fromIntegral y * 8)
-                --     $ vstFb s
-                -- forM_ (zip [0..] [48,52,45,111,112,32,114,44,105,109,109] :: [(Int, Int)]) \(idx, b) -> do
-                --   blitTile 0 (vstVRAM s)
-                --     (fromIntegral b)
-                --     (fromIntegral $ idx * 8, 0)
-                --     $ vstFb s
-                pure $! s
-                  { vstTick = 0
-                  , vstLy = 0
-                  , vstRenderState = RenderOAMSearch
-                  }
-                else
-                pure $! s
-                { vstTick = 0
-                , vstLy = ly
-                }
-          | otherwise -> pure $! s
-            { vstTick = tick
-            }
-
-  , compWrite = \s a v -> {-# SCC "ComponentVideoWrite" #-} case videoAddrRange a of
-      Nothing -> throwM $ VideoError $ mconcat
-        [ "write address out of bounds for video system: "
-        , pretty a
-        ]
-      Just (VideoAddrVRAM off) -> do
-        log $ "write to vram: " <> pretty (0x8000 + off)
-        pure s
-          { vstVRAM =
-            V.modify (\ms -> MV.write ms (fromIntegral $ unAddr off) v) $ vstVRAM s
-          }
-      Just (VideoAddrStatus off) -> case off of
-        0x0 -> do
-          log $ "write to lcdc: " <> show8 v
-          pure s { vstLcdc = v }
-        0x1 -> pure s
-        0x2 -> pure s { vstScx = v }
-        0x3 -> pure s { vstScy = v }
-        0x4 -> pure s
-        0x5 -> pure s
-        0x6 -> pure s
-        0x7 -> pure s
-        0x8 -> pure s
-        0x9 -> pure s
-        0xa -> pure s
-        0xb -> pure s
-        _ -> pure s
-
-  , compRead = \s a -> {-# SCC "ComponentVideoRead" #-} case videoAddrRange a of
-      Nothing -> throwM $ VideoError $ mconcat
-        [ "read address out of bounds for video system: "
-        , pretty a
-        ]
-      Just (VideoAddrStatus off) -> case off of
-        0x0 -> pure $ vstLcdc s
-        0x1 -> pure 0x00
-        0x2 -> pure $ vstScx s
-        0x3 -> pure $ vstScy s
-        0x4 -> pure $ vstLy s
-        -- 0x4 -> pure 0x00
-        0x5 -> pure 0x00
-        0x6 -> pure 0x00
-        0x7 -> pure 0x00
-        0x8 -> pure 0x00
-        0x9 -> pure 0x00
-        0xa -> pure 0x00
-        0xb -> pure 0x00
-        _ -> pure 0x00
-      Just (VideoAddrVRAM off) -> do
-        case vstVRAM s V.!? fromIntegral (unAddr off) of
-          Nothing -> error "unreachable"
-          Just v -> pure v
-  }
diff --git a/fig-emulator-gb/src/Fig/Emulator/GB/Test/Instr.hs b/fig-emulator-gb/src/Fig/Emulator/GB/Test/Instr.hs
deleted file mode 100644
index 647e03a..0000000
--- a/fig-emulator-gb/src/Fig/Emulator/GB/Test/Instr.hs
+++ /dev/null
@@ -1,176 +0,0 @@
-{-# Language TemplateHaskell, ApplicativeDo #-}
-module Fig.Emulator.GB.Test.Instr where
-
-import Control.Lens.TH (makeLenses)
-
-import Control.Lens ((^.))
-import Control.Monad.State.Strict (StateT(..))
-
-import Data.Word (Word8, Word16)
-import qualified Data.Vector as V
-import qualified Data.Aeson as Aeson
-
-import qualified Text.Printf as Pr
-
-import Fig.Prelude
-import Fig.Emulator.GB.Utils
-import Fig.Emulator.GB.CPU
-import Fig.Emulator.GB.CPU.Instruction
-import Fig.Emulator.GB.Bus (Bus(..), Addr(..))
-import qualified Fig.Emulator.GB.Bus as Bus
-import Fig.Emulator.GB.Component.RAM
-
-newtype InstrTestError = InstrTestError Text
-  deriving Show
-instance Exception InstrTestError
-instance Pretty InstrTestError where
-  pretty (InstrTestError b) = mconcat
-    [ "Instruction test error: "
-    , b
-    ]
-
-data TestVals = TestVals
-  { _testvalsA :: !Word8
-  , _testvalsB :: !Word8
-  , _testvalsC :: !Word8
-  , _testvalsD :: !Word8
-  , _testvalsE :: !Word8
-  , _testvalsF :: !Word8
-  , _testvalsH :: !Word8
-  , _testvalsL :: !Word8
-  , _testvalsPC :: !Word16
-  , _testvalsSP :: !Word16
-  , _testvalsRAM :: ![(Word16, Word8)]
-  }
-makeLenses 'TestVals
-instance Aeson.FromJSON TestVals where
-  parseJSON = Aeson.withObject "TestVals" $ \v -> do
-    _testvalsA <- v Aeson..: "a"
-    _testvalsB <- v Aeson..: "b"
-    _testvalsC <- v Aeson..: "c"
-    _testvalsD <- v Aeson..: "d"
-    _testvalsE <- v Aeson..: "e"
-    _testvalsF <- v Aeson..: "f"
-    _testvalsH <- v Aeson..: "h"
-    _testvalsL <- v Aeson..: "l"
-    _testvalsPC <- v Aeson..: "pc"
-    _testvalsSP <- v Aeson..: "sp"
-    _testvalsRAM <- v Aeson..: "ram"
-    pure TestVals{..}
-
-data Testcase = Testcase
-  { _testcaseName :: !Text
-  , _testcaseInitial :: !TestVals
-  , _testcaseFinal :: !TestVals
-  }
-makeLenses 'Testcase
-
-instance Aeson.FromJSON Testcase where
-  parseJSON = Aeson.withObject "Testcase" $ \v -> do
-    _testcaseName <- v Aeson..: "name"
-    _testcaseInitial <- v Aeson..: "initial"
-    _testcaseFinal <- v Aeson..: "final"
-    pure Testcase {..}
-
-readTestcases :: FilePath -> IO [Testcase]
-readTestcases p = liftIO (Aeson.decodeFileStrict p) >>= \case
-  Just ts -> pure ts
-  Nothing -> throwM . InstrTestError $ "failed to read testcases at " <> pack p
-
-cpuInstrTest :: TestVals -> IO CPU
-cpuInstrTest vs = do
-  let
-    (z, n, h, c) = w8flags $ vs ^. testvalsF
-    initialBus = Bus [compWRAM 0x0000 $ 64 * 1024]
-  finalBus <- foldM (\b (addr, v) -> Bus.write b (Addr addr) v) initialBus $ vs ^. testvalsRAM
-  pure CPU
-    { _lastPC = 0x0
-    , _lastIns = Nop
-    , _running = True
-    , _regs = initialRegs
-      { _regA = vs ^. testvalsA
-      , _regB = vs ^. testvalsB
-      , _regC = vs ^. testvalsC
-      , _regD = vs ^. testvalsD
-      , _regE = vs ^. testvalsE
-      , _regH = vs ^. testvalsH
-      , _regL = vs ^. testvalsL
-      , _regPC = vs ^. testvalsPC - 1
-      , _regSP = vs ^. testvalsSP
-      , _regFlagZ = z
-      , _regFlagN = n
-      , _regFlagH = h
-      , _regFlagC = c
-      }
-    , _bus = finalBus
-    }
-
-checkCPU :: Text -> TestVals -> CPU -> CPU -> IO ()
-checkCPU tnm vs initial c = do
-  let
-    flag f = if f then "1" else "0"
-    rreg8 = pack . Pr.printf "%02X"
-    rreg16 = pack . Pr.printf "%04X"
-    dumpRegs :: Text -> Registers -> Text
-    dumpRegs prefix r = mconcat
-      [ prefix, " registers:\t"
-      , "A: ", rreg8 $ r ^. regA
-      , ", B: ", rreg8 $ r ^. regB
-      , ", C: ", rreg8 $ r ^. regC
-      , ", D: ", rreg8 $ r ^. regD
-      , ", E: ", rreg8 $ r ^. regE
-      , ", H: ", rreg8 $ r ^. regH
-      , ", L: ", rreg8 $ r ^. regL
-      , ", PC: ", rreg16 $ r ^. regPC
-      , ", SP: ", rreg16 $ r ^. regSP
-      ]
-    dumpFlags :: Text -> Registers -> Text
-    dumpFlags prefix r = mconcat
-      [ prefix, " flags:\t"
-      , "Z: ", flag $ r ^. regFlagZ
-      , ", N: ", flag $ r ^. regFlagN
-      , ", H: ", flag $ r ^. regFlagH
-      , ", C: ", flag $ r ^. regFlagC
-      ]
-    check :: (Eq a) => (a -> Text) -> Text -> a -> a -> IO ()
-    check pr nm eval aval = if eval == aval
-      then pure ()
-      else throwM . InstrTestError $ mconcat
-      [ "while running test ", tnm, ":\n"
-      , nm <> " mismatch: expected "
-      , pr eval, ", got ", pr aval
-      , "\n", dumpRegs "Initial" $ initial ^. regs
-      , "\n", dumpRegs "Final" $ c ^. regs
-      , "\n", dumpFlags "Initial" $ initial ^. regs
-      , "\n", dumpFlags "Final" $ c ^. regs
-      ]
-  check rreg8 "register A" (vs ^. testvalsA) (c ^. regs . regA)
-  check rreg8 "register B" (vs ^. testvalsB) (c ^. regs . regB)
-  check rreg8 "register C" (vs ^. testvalsC) (c ^. regs . regC)
-  check rreg8 "register D" (vs ^. testvalsD) (c ^. regs . regD)
-  check rreg8 "register E" (vs ^. testvalsE) (c ^. regs . regE)
-  check rreg8 "register H" (vs ^. testvalsH) (c ^. regs . regH)
-  check rreg8 "register L" (vs ^. testvalsL) (c ^. regs . regL)
-  check rreg16 "PC" (vs ^. testvalsPC - 1) (c ^. regs . regPC)
-  check rreg16 "SP" (vs ^. testvalsSP) (c ^. regs . regSP)
-  let (fz, fn, fh, fc) = w8flags $ vs ^. testvalsF
-  check flag "flag Z" fz (c ^. regs . regFlagZ)
-  check flag "flag N" fn (c ^. regs . regFlagN)
-  check flag "flag H" fh (c ^. regs . regFlagH)
-  check flag "flag C" fc (c ^. regs . regFlagC)
-  forM_ (vs ^. testvalsRAM) \(Addr -> addr, eval) -> do
-    Bus.read (c ^. bus) addr >>= \case
-      Nothing -> throwM . InstrTestError $ "failed to read expected address: " <> pretty addr
-      Just aval -> check rreg8 ("memory address " <> pretty addr) eval aval
-
-runTestcase :: Testcase -> IO ()
-runTestcase tc = liftIO do
-  initial <- cpuInstrTest $ tc ^. testcaseInitial
-  let
-    body :: Emulating Instruction
-    body = do
-      ins <- decode
-      step ins
-      pure ins
-  (ins, final) <- runStateT (runEmulating body) initial
-  checkCPU (tc ^. testcaseName <> " (" <> tshow ins <> ")") (tc ^. testcaseFinal) initial final
diff --git a/fig-emulator-gb/src/Fig/Emulator/GB/Utils.hs b/fig-emulator-gb/src/Fig/Emulator/GB/Utils.hs
deleted file mode 100644
index 4ad6f24..0000000
--- a/fig-emulator-gb/src/Fig/Emulator/GB/Utils.hs
+++ /dev/null
@@ -1,90 +0,0 @@
-module Fig.Emulator.GB.Utils where
-
-import Fig.Prelude
-
-import Prelude (fromIntegral)
-
-import qualified Text.Printf as Pr
-
-import Data.Word (Word8, Word16)
-import Data.Int (Int8)
-import Data.Bits
-
-show8 :: Word8 -> Text
-show8 = pack . Pr.printf "%02X"
-
-show16 :: Word8 -> Text
-show16 = pack . Pr.printf "%04X"
-
-w8w8 :: Word8 -> Word8 -> Word16
-w8w8 high low = shiftL (fromIntegral high) 8 .|. fromIntegral low
-
-w16hi :: Word16 -> Word8
-w16hi v = fromIntegral $ shiftR v 8
-
-w16lo :: Word16 -> Word8
-w16lo v = fromIntegral $ v .&. 0xff
-
-w8bit :: Int -> Word8 -> Bool
-w8bit i v = shiftR v i .&. 0b1 == 1
-
-w8bits2 :: Int -> Word8 -> Word8
-w8bits2 i v = shiftR v (i - 1) .&. 0b11
-
-w8bits3 :: Int -> Word8 -> Word8
-w8bits3 i v = shiftR v (i - 2) .&. 0b111
-
-w8bits4 :: Int -> Word8 -> Word8
-w8bits4 i v = shiftR v (i - 3) .&. 0b1111
-
-flagsw8 :: Bool -> Bool -> Bool -> Bool -> Word8
-flagsw8 z n h c =
-  shiftL (if z then 1 else 0) 7
-  .|. shiftL (if n then 1 else 0) 6
-  .|. shiftL (if h then 1 else 0) 5
-  .|. shiftL (if c then 1 else 0) 4
-
-w8flags :: Word8 -> (Bool, Bool, Bool, Bool)
-w8flags x = (z, n, h, c)
-  where
-    z = w8bit 7 x
-    n = w8bit 6 x
-    h = w8bit 5 x
-    c = w8bit 4 x
-
-zext :: Word8 -> Word16
-zext = fromIntegral
-
-sext :: Word8 -> Word16
-sext x = fromIntegral y
-  where
-    y :: Int8
-    y = fromIntegral x
-
-trunc :: Word16 -> Word8
-trunc = fromIntegral
-
-addC :: Bool -> Word8 -> Word8 -> (Word8, Bool)
-addC c x y = (trunc res, shiftR res 8 .&. 1 == 1)
-  where
-    res :: Word16
-    res = zext x + zext y + if c then 1 else 0
-
-addH :: Bool -> Word8 -> Word8 -> Bool
-addH c x y = shiftR res 4 .&. 1 == 1
-  where
-    xlo = x .&. 0xf
-    ylo = y .&. 0xf
-    res :: Word8
-    res = xlo + ylo + if c then 1 else 0
-
-subC :: Bool -> Word8 -> Word8 -> (Word8, Bool)
-subC c x y = (trunc $ xs - ys, yz > xz)
-  where
-    xs = sext x
-    ys = sext y + if c then 1 else 0
-    xz = zext x
-    yz = zext y + if c then 1 else 0
-
-subH :: Bool -> Word8 -> Word8 -> Bool
-subH c x y = zext (w8bits4 3 x) < (zext (w8bits4 3 y) + if c then 1 else 0)