一昨年の夏にどうやってもテスト通らなくて放置してたゲームボーイエミュレータを根本的に書き換えてみたらだいぶましになった。最初は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 } -- CPU.hs 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
