STMとロックについて

だいぶん間が開いてしまいましたが、その3です。

STMモナドによる操作は、ロックフリーです。 synchronize だとか lock だとか unlock だとかいうキーワードを書く必要はありません。 しかし、それは Haskell のコードからの視点のようです。 内部的にはロックを使っています。 そこで、ロックを実感するために、このようなコードを実行してみます。 import宣言と、ここにない関数はその1、その2から持ってきてください。

fib :: Int -> Int
fib 0 = 0
fib 1 = 1
fib n = fib (n - 1) + fib (n - 2)

threadA :: TVar Int -> IO ()
threadA v =
    do n <- atomically $ readTVar v
       print n
       atomically $ writeTVar v (n + 1)

threadB :: TVar Int -> IO ()
threadB v = atomically $ writeTVar v $ fib 40

main :: IO ()
main = do c <- newCounter
          v <- newTVarIO 0
          fork c $ every 500 $ threadA v
          fork c $ threadB v
          waitCounter c 2

fib は有名なフィボナッチ数列です。 時間がかからないと意味がないので、わざと遅い実装にしています。 threadA は fib 40 を計算して、2つのスレッドで共有している変数 v に結果を代入しています。 threadB は v の値を出力して v を1増やしています。

このコードを実行すると、

0
1
2
  (中略)
102334155
102334156
102334157

このような結果が期待されます。 しかし、このような結果にはなりません。 実際には、

102334155
102334156
102334157
102334158
102334159

のようになります。0, 1, 2 ...の値は出力されません。

atomicallyとロック

atomically は、内部的にTVarをロックしているようです。 そのロックの影響で、前章でのサンプルコードは期待されるような結果になりません。 atomically はトランザクションをコミットする時に関係するTVarを全てロックします。 ロックされているTVarは他のスレッドから参照することも、書き込むこともできません。

また、Haskellは遅延評価をする言語です。 atomically がTVarのロックを取得した後に、 v に書き込むための値を計算します。 ( readTVar や writeTVar をする時にロックしているわけではありません。) しかし、 fib 40 の計算には非常に時間がかかります。 TVarをロックした後に計算しているため、``v`` を読もうとしている threadA も長時間ブロックされてしまいます。

正格評価をしてみる

threadB の内容を変更し $ の代りに正格性のある $! を使ってみます。

threadB :: TVar Int -> IO ()
threadB v = atomically $ writeTVar v $! fib 40

長いので変化のある所だけにしますが、結果はこのようになります。

18
19
20
102334155
102334156
102334157

今回は期待通りに動いています。 writeTVar する時に fib 40 の計算をすましているので、 atomically の内部で計算待ちでロックしなくなります。

しかし、手元の環境では -O と最適化フラグを付けてコンパイルすると、 遅延評価版と同じ結果になってしまいます。 インライン展開が悪さをしているようです。

{-# NOINLINE fib #-}
fib :: Int -> Int
fib 0 = 0
fib 1 = 1
fib n = fib (n - 1) + fib (n - 2)

このように、 NOINLINE プラグマを付けると、最適化を行っても大丈夫でした。

でも…

atomically の中で正格評価を行うのは時に問題となります。 プログラムをこのように書き換えてみます。

{-# NOINLINE fib #-}
fib :: Int -> Int
fib n = trace ("fib " ++ show n) $ fib' n
    where fib' 0 = 0
          fib' 1 = 1
          fib' n = fib' (n - 1) + fib' (n - 2)

threadA :: TVar Int -> IO ()
threadA v = do x <- atomically modify
               print x
    where modify = do x <- readTVar v
                      writeTVar v $ x + 1
                      return x

threadB :: TVar Int -> IO ()
threadB v = atomically $ do
              x <- readTVar v
              writeTVar v $! fib x

main :: IO ()
main = do c <- newCounter
          v <- newTVarIO 35
          fork c $ every 50 $ threadA v
          fork c $ threadB v
          waitCounter c 2

まず、変更内容についてですが、 fib が実行された時に、引数の n の値をトレースするようにします。 threadA は次々と v の内容を変化させ、 threadB は v の内容を使って fib を計算しています。 main の内容は変化していませんが、 threadA の実行間隔が短い方がわかりやすいので、変更しています。

このプログラムを実行すると、このようになります。 fib が何度も呼び出され、いつまでたっても計算が終りません。

fib 35
35
fib 36
36
fib 37
37
fib 38
38
fib 39
39
fib 40
40

threadB が fib を計算中に threadA によって v の内容が書き換えられるため、 threadB の atomically が何度も再実行されます。 遅延評価( $ を使う)コードにしておくと、 v のロックを得てから fib を計算するため、 何回も実行されることはありません。(そのかわり threadA の実行は止まりますが。)

外で計算する

threadB の内容を書き換えて、 atomically の外で fib を計算するようにすると、 fib が何度も計算されることはなく、 threadA の実行も止まりません。 (ここで、 $! を使って正格評価にしないと、意味がありません。)

threadB :: TVar Int -> IO ()
threadB v = do x <- atomically $ readTVar v
               y <- return $! fib x
               atomically $ writeTVar v y

ロックフリーと言えども

ロックフリーと言えども、 STM を使う上ではロックに気を付ける必要がありそうです。 ロックの開放忘れを気にしなくてもよかったり、 ロックの順番を気にしなくてもよかったり、STMモナドが合成できたり、いいこともありますが、 ややこしいバグを発生させる可能性もありそうです。

その4

その4に続くかもしれません。