一昨年の夏にどうやってもテスト通らなくて放置してたゲームボーイエミュレータを根本的に書き換えてみたらだいぶましになった。最初はlens/Stateを使う方針でCPUのレジスタなんかをレコードのフィールドにぶち込んでそれらを書き換えていく感じだったが、ざっと書いたところでひどく遅くてかなしくなったので放置していた。今回はレジスタなどの本質的にミュータブルなデータを全部Vector.Unboxed.Mutableにぶちこんだら早くなったという話。そりゃそうなんよ。
lens/StateMでできるだけイミュータブルなレコード更新をしようとした型設計。
type CPU a = StateT CPUState (StateT MBCState (StateT LoggerState IO)) a
data CPUState = CPUState {
_a, __f, _b, _c, _d, _e, _h, _l :: Word8,
_sp, _pc :: Word16,
...
} deriving Show
makeLenses ''CPUState
フラグ更新などはFレジスタに詰め込まれているのでlens関数を用いてアクセサーを書ける
carry :: Lens' CPUState Bool
carry = lens get set
where
get c = testBit (__f c) 4
set c b =
if b then
c { __f = setBit (__f c) 4 }
else
c { __f = clearBit (__f c) 4 }
命令の実装などはStateをつかうことで、たとえばrustの実装と比べるとselfをまるっと省略ができている。それでありながら動的言語の様な記法でもある。一方で変数名にcarryやhalfもしくは省略してcとhを使いたかったが、フラグとレジスタのアクセサーと名前がかぶるので使えないあたりが不便なところ。名前空間。
add :: OP -> CPU ()
add op = do
(a', c', h') <- add8CarryHalf <$> use a <*> readOP8 op
a .= a'
zero .= (a' == 0)
negative .= False
half .= h'
carry .= c'
fn add(&mut self, op: OP) {
let (a, carry, half) = self.a.add_carry_half(self.load8(op));
self.a = a;
self.set_carry(carry);
self.set_half(half);
self.set_negative(false);
self.set_zero(self.a == 0);
}
上記のhaskellの実装ではモナドスタックをつかっており、なかなかモナモナとネストしてるあたり、こんなんでいいのか感もいなめない。モナドトランスフォーマーの宿命である。バベルの塔のごとく積み上がるモナドスタックをどうにかしようという試みとしてEffectなるものがある。最近ではOCamlに公式に採用されたらしい。よくはしらんけど。そんなんでhaskellのeffect実装を調べた感じではいくつかあるものの比較的浅いスタックだとmtlより遅いらしいということで採用は見送った。
そしてそのモナドスタックを潰しながら実行してく。
type Gameboy a = StateT GameboyState IO a
data GameboyState = GameboyState {
_cpu :: CPUState,
_mbc :: MBCState,
_logger :: LoggerState,
_car :: Cartrige
}
makeLenses ''GameboyState
stepGameboy :: GameboyState -> IO GameboyState
stepGameboy gb = do
let run = flip runStateT
(((_,cpu'),mbc'),logger') <- run (gb^.logger) $ run (gb^.mbc) $ run (gb^.cpu) executeCPU
pure $ gb
& (cpu .~ cpu')
. (mbc .~ mbc')
. (logger .~ logger')
(((_,cpu'),mbc'),logger') <- run (gb^.logger) $ run (gb^.mbc) $ run (gb^.cpu) executeCPU
という風にモナドスタックみを感じる。もうちょいましになりそうだけど。上記の様な実装ではゲームプレイはできない処理速度となった。一応StateとIORefとIOVectorを比べてStateが一番マシだったのでそれを採用したので、haskellでは無理なのかとかなしくなった。
その実装をたまに思い出しては少し手を入れたりしていた。モナドスタックを潰してステートをフラットにしたりした。CPUの命令がGBモナドになるので微妙な開放感がある。3倍くらい早くなったがそれでもまだ遅かった。
type GB a = StateT GBState IO a
data GBState = GBState {
_cpu :: CPUState,
_mbc :: MBCState,
_logger :: LoggerState
}
add :: OP -> GB ()
add op = do
(a', c', h') <- add8CarryHalf <$> (use $ cpu.a) <*> readOP8 w
cpu %=
(a .~ a')
. (zero .~ (a' == 0))
. (negative .~ False)
. (half .~ h')
. (carry .~ c')
そんなところで放置してたが今年の冬にrustで書いてみたら、あまりの実装のラクさと速さに余計にhaskellとはなんだったのかとかなしみをいっそう深めたのでもう一度haskell実装を考えてみることにした。最適化をすればC++並みの速度がでるとの記載をはるか昔に見たのを思い出しながら。
IOVectorのベンチは取ったがUnboxedを失念していたのでUnboxedも見てみたところ、なんかよくわからんほどの差がでたので、なぜ忘れていたのかとさらにかなしくなった。haskellのデータはサンクと呼ばれる形で保持されている。一見ただのInt8であってもdata Int8 = I8# Int8#
というようにdata型になっている。これはヒープのポインターであり遅延評価のときなどに役立つクロージャのようなもの。しかし遅延評価の必要もないプリミティブなデータであればその様なラベルを省略して生のデータとして扱えるよねというのがUnboxedだ。ということで「もう状態全部Vector.Unboxed.Mutableにぶち込もう」となり、以下のようなデータ構造と命令の実装になった。
newtype Store a = Store (MVector (PrimState IO) a)
data CPU = CPU {
mbc :: MBC,
regs8 :: Store Word8,
regs16 :: Store Word16,
...
}
data CPURegisters8 = A | F | B | C | D | E | H | L | IME | Halt | Cycle
deriving (Enum, Show, Eq)
readReg8 :: CPU -> CPURegisters8 -> IO Word8
readReg8 (CPU {..}) r = readStore regs8 $ fromEnum r
writeReg8 :: CPU -> CPURegisters8 -> Word8 -> IO ()
writeReg8 (CPU {..}) r n = writeStore regs8 (fromEnum r) n
readFlag :: CPU -> CPUFlags -> IO Bool
readFlag cpu flag = do
f <- readReg8 cpu F
pure $ testBit f $ 4 + fromEnum flag
writeFlag :: CPU -> CPUFlags -> Bool -> IO ()
writeFlag cpu flag bool = do
f <- readReg8 cpu F
let f' = (if bool then setBit else clearBit) f (4 + fromEnum flag)
writeReg8 cpu F $ f' .&. 0b11110000
add :: CPU -> Op8 -> IO ()
add cpu op = do
(a, carry, half) <- addCarryHalf <$> readReg8 cpu A <*> readOp8 cpu op
writeReg8 cpu A a
writeFlag cpu Carry carry
writeFlag cpu Half half
writeFlag cpu Negative False
writeFlag cpu Zero $ a == 0
StoreはただのVector.Unboxed.Mutableのラッパーである。CPURegistersをEnumのinstanceとすることでそのままVectorのインデックスとして扱える。速さを優先してlensもStateも使わなかったのですべての関数で明示的にそれらの状態を引き回す記述が増えている。こうなってくるとただのCよりめんどくさくて遅いCである気もしてくる。
ただだいぶ早くなった。テスト用のROMを26000000CPUStepくらい回すとテストが終わる。rust版と一秒差くらいなら悪くないんじゃないかな。両方とも最適化の余地が全然あるとは思う。haskellではPPUなどを書いてないのでゲームプレイはできない。終わり。
> time { stack run -- .\rom\gb-test-roms\cpu_instrs\cpu_instrs.gb | Out-Default }
cpu_instrs
01:ok 02:ok 03:ok 04:ok 05:ok 06:ok 07:ok 08:ok 09:ok 10:ok 11:ok
Passed all tests
TotalSeconds : 5.6943804
> time { cargo run --release .\rom\gb-test-roms\cpu_instrs\cpu_instrs.gb | Out-Default }
cpu_instrs
01:ok 02:ok 03:ok 04:ok 05:ok 06:ok 07:ok 08:ok 09:ok 10:ok 11:ok
Passed all tests
TotalSeconds : 4.6624661
追記。rust版だけloggerがオンになってたのでオフにして計測し直した。約2.5秒早くなった。
> time { cargo run --release .\rom\gb-test-roms\cpu_instrs\cpu_instrs.gb | Out-Default }
cpu_instrs
01:ok 02:ok 03:ok 04:ok 05:ok 06:ok 07:ok 08:ok 09:ok 10:ok 11:ok
Passed all tests
TotalSeconds : 2.16294
動的にステートフルなトレイトオブジェクト
ゲームボーイにはMBCというコンポーネントがある。メモリとROM(ゲームソフト)にアクセスするためのもので16bitしかないメモリアドレス空間を拡張的に使うものだ。MBCにはいくつもの種類があり、微妙に実装が違う。どのMBCを使うかはを実行時に決まるので、ここで他言語におけるインターフェイスやトレイトオブジェクト的なものがほしいのだが、haskellには静的な型クラスしかない(ゆうてここあんま調べてなかったな。ふつうにData.Dynamicでいけるんかな)。そんなこんなでhaskellでもlens/Stateでステートフルなトレイトオブジェクトもどきを使った。
type MBC a = StateT MBCState (StateT LoggerState IO) a
data MBCState = MBCState {
_mbcnState :: MBCNState,
_memory :: Memory,
_reader :: Int -> MBC Word8,
_writer :: Int -> Word8 -> MBC ()
}
data MBCNState
= MBC0State
| MBC1State {
_bank :: Int,
_bank1 :: Int,
_bank2 :: Int,
_bankRAMX :: Int,
_enableRAMX :: Bool,
_bankingMode :: Bool
}
deriving Show
makeLenses ''MBCState
makeLenses ''MBCNState
newMBCState :: Cartrige -> IO MBCState
newMBCState car = do
_memory <- newMemory car
pure $ MBCState { .. }
where
(_mbcnState, _reader, _writer) = case car^.mbcType of
MBC0 -> (MBC0State, readMBC0, writeMBC0)
MBC1 -> (MBC1State 0x4000 1 0 0 False False, readMBC1, writeMBC1)
_ -> undefined
newするタイミングでROMに使われているMBCのタイプを読み取り実装と状態を選択するVTable的なやつ。
readMBC1 :: Int -> MBC Word8
readMBC1 i
| 0 <= i && i <= 0x3fff = (V.! i) <$> (use $ memory.cartrige.rom)
| 0x4000 <= i && i <= 0x7fff = do
(Just b) <- preuse $ mbcnState.bank
rom' <- use $ memory.cartrige.rom
pure (rom' V.! (b .|. (i - 0x4000)))
| 0x8000 <= i && i <= 0x9fff = do
ram' <- use $ memory.ram
lift $ VM.read ram' i
| 0xa000 <= i && i <= 0xbfff = do
ramx' <- use $ memory.ramx
(Just b) <- preuse $ mbcnState.bankRAMX
if b == 0 then do
ram' <- use $ memory.ram
lift $ VM.read ram' i
else
lift $ VM.read ramx' (b .|. (i - 0xa000))
| otherwise = do
ram' <- use $ memory.ram
lift $ VM.read ram' i
preuseしてちゃんと自分のステートを引っ張ってこれる。しかしpreuseはおそらく毎回直和型を走査してデータを引っ張ってきているのでコストがかかる。newしたタイミングでそれは決定していて無駄な走査なので気になる点ではある。
Vector.Unboxed.Mutableで書き直した版ではStore Word64にまとめて放り込んでいて、すべてのMBCTypeの関数で同じ型のMBCStateを引き回してる。readするたびMBCTypeを判別しているので良くない気がする。
readMBC :: MBC -> Word16 -> IO Word8
readMBC mbc@(MBC {..}) i = case mbcType cartridge of
MBC1 -> readMBC1 mbc i
_ -> error "readMBC unimplement MBCType"
そういえば、zig
一昨年の夏、僕がhaskellに絶望していたころzigが流行っていたのでzigでも書いたのを思い出した。早すぎて意味がわからん。こんだけちがうとrust版もなんかおかしいな。
> time { zig build run -Drelease-fast -- .\rom\gb-test-roms\cpu_instrs\cpu_instrs.gb }
Serial:
cpu_instrs
01:ok 02:ok 03:ok 04:ok 05:ok 06:ok 07:ok 08:ok 09:ok 10:ok 11:ok
Passed all tests
TotalSeconds : 0.937751