Haskell Windows Ctrl-C 動作確認

Haskell

コード

コードは前回記事と同じです（再掲）。

Git リポジトリーはこちら。

import Control.Concurrent
import Control.Monad
import System.Exit
import System.IO
import System.Win32.Console.CtrlHandler

main :: IO ()
main = do
    tid <- myThreadId
    let
      handler event = do
        if event == cTRL_C_EVENT
          then do
            putStrLn "goodbye!"
            killThread tid
            pure True
          else
            pure False
    pHandler <- mkHandler handler
    success <- c_SetConsoleCtrlHandler pHandler True
    when (not success) $ do
      putStrLn "SetConsoleCtrlHandler failed"
      exitFailure

    let
      loop n = do
        putStr $ show n ++ ", "
        hFlush stdout
        threadDelay 1000000
        loop (n+1)
    loop 0

これを次の4通りのオプションでビルドします。

name: windows-interruption

dependencies:
- base >= 4.7 && < 5
- Win32

executables:
  app-rtsopts-threaded:
    main: Main.hs
    source-dirs: .
    ghc-options:
    - -rtsopts
    - -threaded

  app-threaded:
    main: Main.hs
    source-dirs: .
    ghc-options:
    - -threaded

  app-rtsopts:
    main: Main.hs
    source-dirs: .
    ghc-options:
    - -rtsopts

  app:
    main: Main.hs
    source-dirs: .

実行

これを実行してみます。

app

タイミングによる。

$ app
0, 1, 2, goodbye!
goodbye!
app.exe: thread killed
（応答がなくなる）
$ app
0, 1, 2, goodbye!
goodbye!
app.exe: thread killed
（終了する）
$ app
0, goodbye!
app.exe: thread killed
app.exe: warning: too many hs_exit()s

また、GHC 8.6.3 でコンパイルしたときですが、下記のようなエラーが出ることもありました。そもそも GHC 8.6.3 は Windows でのビルドにバグがあるので、他は GHC 8.4.4 を使っています。

$ app
0, 1, 2, goodbye!
goodbye!

Access violation in generated code when writing 0x20

 Attempting to reconstruct a stack trace...

app.exe: internal error: scavenge_stack: weird activation record found on stack: 5212000
    (GHC version 8.6.3 for x86_64_unknown_mingw32)
    Please report this as a GHC bug:  http://www.haskell.org/ghc/reportabug
   Frame        Code address
 * 0x484dd00    0x736b99

app-rtsopts

タイミングによる。

$ app-rtsopts
0, 1, 2, goodbye!
goodbye!
app-rtsopts.exe: thread killed
$ app-rtsopts
0, 1, 2, goodbye!
app-rtsopts.exe: thread killed
app-rtsopts.exe: warning: too many hs_exit()s

app-rtsopts +RTS --install-signal-handlers=no

--install-signal-handlers はデフォルトでは yes。

タイミングによる。

$ app-rtsopts +RTS --install-signal-handlers=no
0, 1, 2, goodbye!
$ app-rtsopts +RTS --install-signal-handlers=no
0, goodbye!
app-rtsopts.exe: thread killed
app-rtsopts.exe: warning: too many hs_exit()s
$ app-rtsopts +RTS --install-signal-handlers=no
0, 1, 2, goodbye!
goodbye!
app-rtsopts.exe: thread killed

app-threaded

想定通りの動作。

$ app-threaded
0, 1, 2, goodbye!
app-threaded.exe: thread killed

app-rtsopts-threaded

想定通りの動作。

$ app-rtsopts-threaded
0, 1, 2, 3, goodbye!
app-rtsopts-threaded.exe: thread killed

app-rtsopts-threaded +RTS --install-signal-handlers=no

想定通りの動作。

$ app-rtsopts-threaded +RTS --install-signal-handlers=no
0, 1, 2, 3, 4, 5, goodbye!
app-rtsopts-threaded.exe: thread killed

まとめ

  • 想定通りの動作
    • app-threaded
    • app-rtsopts-threaded
    • app-rtsopts-threaded +RTS --install-signal-handlers=no
  • タイミングによる
    • app
    • app-rtsopts
    • app-rtsopts +RTS --install-signal-handlers=no

タイミングによるときの動作。

  • ハンドラー → 終了する
  • ハンドラー → ハンドラー → thread killed 例外 → 応答がなくなる
  • ハンドラー → ハンドラー → thread killed 例外 → 終了する
  • ハンドラー → thread killed 例外 → too many hs_exit()s 例外 → 終了する

今後

ハンドラーが2回呼ばれるときは killThread も2回呼んでいるはずなので、その後がおかしくなることはありそう。また killThread しているが、それは自分自身ではないのかの確認もしたい。

System.Win32.Console.CtrlHandler とか GHC RTS を追うしかない気がするので追ってみます。

GHC RTS はこの辺（rts/win32/ConsoleHandler.c）からかなぁ。