今日の Emacs Lisp

(when (window-system)
  (set-frame-parameter nil 'fullscreen 'nil))

Emacs 起動直後、なぜか Emacs が最大化されてしまい、かつ描画がちょっとおかしな感じになっていた。なので起動後は毎回、最大化解除 → 最大化 (or そのまま) というのを行う必要があった。
何気ない操作だけども、かったるい。原因をつきとめてそこに対処を入れるというのが本筋だろうけども、それも面倒くさい。なので起動時に画面最大化を解除する、という処理を書いた。

追記

別件で必要にかられて Emacs を 23.1.1 から 23.2 にバージョンアップしたところ、上で書いた問題が解決してた。ので今日の Emacs Lisp は廃棄した。

Common Lisp でサーバプログラム - その 3

ちと間が空いたけども、前回の続き。今回の目標は多重化 IO を使うこと。

ライブラリ

まず多重化 IO を使うにあたって、これを利用できるライブラリを探した。何個かあったんだけど、今回は IOLib を選んだ。これを選んだ理由はカバーしている範囲が広いということから。usocket はソケットだけに絞ったライブラリだけども、IOLib はファイル IO からソケットを使ったネットワークプログラミング、それと今回取り上げる多重化 IO など、広範囲に渡ってカバーしている。

asdf スクリプト

使うライブラリが変わったので asdf スクリプトにも変更を入れた。

(defsystem echo-server
  :components ((:file "packages")
               (:file "echo-server" :depends-on ("packages")))
  :depends-on (:iolib))

サーバ本体

前回は前々回からの diff を載せたが、今回は前回から大きく変わっているので、いきなり本体プログラムを載せることにする。とは言っても、ほとんどチュートリアルの ex6-serverのプログラムを書き写しただけ。違うのは、名前と細々した部分をユーティリティ化しているところだけ。あとログ出力は全部消した。

(in-package :echo-server)

(defvar *event-base*)
(defvar *open-connects*)

(defun make-disconnector (socket)
  (lambda (who port)
    (iolib:remove-fd-handlers *event-base* (iolib:socket-os-fd socket))
    (close socket)
    (remhash `(,who ,port) *open-connects*)))

(defmacro print-error (control-string &rest format-args)
  `(format *error-output* ,control-string ,@format-args))

(defun make-echoer (socket who port disconnector)
  (labels ((close-client ()
             (funcall disconnector who port))
           (close-with-error (msg)
             (print-error msg)
             (close-client)))
    (lambda (fd event exception)
      (declare (ignore fd event exception))
      (handler-case
          (let ((line (read-line socket)))
            (format socket "~A~%" line)
            (finish-output socket)
            (when (string= line "quit")
              (close-client)))
        (iolib:socket-connection-reset-error ()
          (close-with-error "Client's connection was reset by peer.~%"))
        (iolib:hangup ()
          (close-with-error "Client went away on a write.~%"))
        (end-of-file ()
          (close-with-error "Client went away on a read.~%"))))))

(defun make-listener-handler (socket)
  (lambda (fd event exception)
    (declare (ignore fd event exception))
    (let ((client (iolib:accept-connection socket :wait t)))
      (when client
        (multiple-value-bind (who port)
            (iolib:remote-name client)
          (setf (gethash `(,who ,port) *open-connects*) client)
          (iolib:set-io-handler *event-base*
                                (iolib:socket-os-fd client)
                                :read
                                (make-echoer client who port (make-disconnector client))))))))

(defun setup-server (socket port)
    (iolib:bind-address socket iolib:+ipv4-unspecified+ :port port :reuse-addr t)
    (iolib:listen-on socket :backlog 5)
    (iolib:set-io-handler *event-base*
                          (iolib:socket-os-fd socket)
                          :read
                          (make-listener-handler socket)))

(defun run-server (port)
  (iolib:with-open-socket (server :connect :passive
                                  :address-family :internet
                                  :type :stream
                                  :ipv6 nil
                                  :external-format '(:utf-8 :eol-style :crlf))
    (setup-server server port)
    (handler-case
        (iolib:event-dispatch *event-base*)
      (iolib:socket-connection-reset-error ()
        (print-error "~A~A~%"
                     "Caught unexpected reset by peer! "
                     "Client connection reset by peer!"))
      (iolib:hangup ()
        (print-error "~A~A~%"
                     "Caught unexpected hangup! "
                     "Client closed connection on write!"))
      (end-of-file ()
        (print-error "~A~A~%"
                     "Caught unexpected end-of-file! "
                     "Client closed connection on read!")))))

(defun start (&key (port 8080))
  (let ((*open-connects* nil)
        (*event-base* nil))
    (unwind-protect
         (handler-case
             (progn
               (setf *open-connects* (make-hash-table :test #'equalp)
                     *event-base* (make-instance 'iolib:event-base))
               (run-server port))
           (iolib:socket-address-in-use-error ()
             (print-error "Bind: Address already in use, forget :reuse-addr t?")))
      (maphash (lambda (k v)
                 (declare (ignore k))
                 (close v :abort t))
               *open-connects*)
      (when *event-base*
        (close *event-base*))
      (finish-output))))

iolib:set-io-handler がイベントハンドラを登録する関数。イベントハンドラは 3 つの引数をとる関数。関数でいいのでクロージャを使うことができ、イベントハンドラからイベントハンドラ生成側のローカル変数にアクセスすることを簡単に実現できる。

次回の目標は非同期 IO を使うこと。

Common Lisp でサーバプログラム - その 2

昨日のやつをいくつか改善。

1. クライアントのコマンドでサーバを落とす方式をやめた

まぁクライアントのコマンドによってサーバを落とすのはあんまりなので。サーバを起動してる REPL で SIGINT なりを飛ばせば落とせるようになった (前も落とすことはできたが、正しく終了させることはできなかった)。

2. サーバソケットを確実に閉じる

こういう目的には unwind-protect を使うらしい。サーバのメインループの部分を unwind-protect で囲って、protect (必ず実行される処理) でサーバソケットを閉じるようにした。

クライアントから EOF を送ってもコネクションが閉じない件は、telnet の使いかたがまずかっただけだった。^] してから Ctrl-D で EOF を送ることができ、サーバ側でも EOF を検出してクライアントソケットを閉じることができた。

以下は前回からの差分。上に挙げたこと以外に、デバッグ出力を消したりしてる。asd ファイルに変更があるのは次への布石なんだけど、実際に使うのはもうちょい先になりそうな気がしてる。

diff --git a/cl-echo-server/echo-server.asd b/cl-echo-server/echo-server.asd
index d72f682..ac0ae2b 100644
--- a/cl-echo-server/echo-server.asd
+++ b/cl-echo-server/echo-server.asd
@@ -1,4 +1,4 @@
 (defsystem echo-server
   :components ((:file "packages")
                (:file "echo-server" :depends-on ("packages")))
-  :depends-on (:usocket))
+  :depends-on (:usocket :bordeaux-threads))
diff --git a/cl-echo-server/echo-server.lisp b/cl-echo-server/echo-server.lisp
index 25ae9a4..04b620e 100644
--- a/cl-echo-server/echo-server.lisp
+++ b/cl-echo-server/echo-server.lisp
@@ -1,7 +1,5 @@
 (in-package :echo-server)
 
-(define-condition stop-server (condition) ())
-
 (defun make-server-socket (port)
   (usocket:socket-listen "localhost" port :reuseaddress t))
 
@@ -10,14 +8,12 @@
   (usocket:socket-close server))
 
 (defun accept-client (server)
-  (prog1 (usocket:socket-accept server)
-    (format t "accept a client!~%")))
+  (usocket:socket-accept server))
 
 (defun trim-input (input)
   (string-trim " ^M" input))
 
 (defun echo-input (client-stream input)
-  (format t "echo to client!~%")
   (format client-stream "~A~%" (trim-input input))
   (force-output client-stream))
 
@@ -27,17 +23,11 @@
 (defun handle-client (client)
   (with-open-stream (stream (usocket:socket-stream client))
       (loop for input = (read-line stream nil nil)
-         while input
-         if (input= input "stop-server") do
-           (error 'stop-server)
-         else do
-           (echo-input stream input))
-      t))
+         while input do
+           (echo-input stream input))))
 
 (defun start (&key (port 8080))
   (let ((server-sock (make-server-socket port)))
-    (handler-case
-        (loop while (handle-client (accept-client server-sock)))
-      (stop-server () (format t "exit...~%"))
-      (condition () (format t "unexpected exit!~%")))
-    (dispose server-sock)))
+    (unwind-protect
+         (loop (handle-client (accept-client server-sock)))
+      (dispose server-sock))))

以下はプログラム全体。ただしサーバ本体だけ。

(in-package :echo-server)

(defun make-server-socket (port)
  (usocket:socket-listen "localhost" port :reuseaddress t))

(defun dispose (server)
  (format t "close...~%")
  (usocket:socket-close server))

(defun accept-client (server)
  (usocket:socket-accept server))

(defun trim-input (input)
  (string-trim " ^M" input))

(defun echo-input (client-stream input)
  (format client-stream "~A~%" (trim-input input))
  (force-output client-stream))

(defun input= (input expected)
  (string= (trim-input input) expected))

(defun handle-client (client)
  (with-open-stream (stream (usocket:socket-stream client))
      (loop for input = (read-line stream nil nil)
         while input do
           (echo-input stream input))))

(defun start (&key (port 8080))
  (let ((server-sock (make-server-socket port)))
    (unwind-protect
         (loop (handle-client (accept-client server-sock)))
      (dispose server-sock))))

Common Lisp でサーバプログラム - その 1

CL でのサーバサイドプログラミングを手探りで色々試す。今回は超単純エコーサーバを書く。仕様は以下。

• 一度に扱えるクライアントは 1 つだけ。
• クライアントから "stop-server" と入力するとサーバを終了させる。
• クライアントで EOF を入力するとクライアントを切断し、次のクライアントの接続を待つ。

ソケットライブラリには usocket を使う。何はともあれ usocket をインストールする。

CL-USER> (asdf-install:install :usocket)

次は asd ファイルを作る。

(defsystem echo-server
  :components ((:file "packages")
               (:file "echo-server" :depends-on ("packages")))
  :depends-on (:usocket))

asd ファイルに定義した通り、ファイル構成は packages.lisp と echo-server.lisp の 2 つ。とりあえず package の定義を含める packages.lisp を作る。

(defpackage :echo-server
  (:use :cl)
  (:export :start))

最後にサーバ本体の echo-server.lisp を作る。

(in-package :echo-server)

(define-condition stop-server (condition) ())

(defun make-server-socket (port)
  (usocket:socket-listen "localhost" port :reuseaddress t))

(defun dispose (server)
  (format t "close...~%")
  (usocket:socket-close server))

(defun accept-client (server)
  (prog1 (usocket:socket-accept server)
    (format t "accept a client!~%")))

(defun trim-input (input)
  (string-trim " ^M" input))

(defun echo-input (client-stream input)
  (format t "echo to client!~%")
  (format client-stream "~A~%" (trim-input input))
  (force-output client-stream))

(defun input= (input expected)
  (string= (trim-input input) expected))

(defun handle-client (client)
  (with-open-stream (stream (usocket:socket-stream client))
      (loop for input = (read-line stream nil nil)
         while input
         if (input= input "stop-server") do
           (error 'stop-server)
         else do
           (echo-input stream input))
      t))

(defun start (&key (port 8080))
  (let ((server-sock (make-server-socket port)))
    (handler-case
        (loop while (handle-client (accept-client server-sock)))
      (stop-server () (format t "exit...~%"))
      (condition () (format t "unexpected exit!~%")))
    (dispose server-sock)))

使ってみる。まずはサーバを起動する。

CL-USER> (echo-server:start)

次にクライアント。クライアントプログラムは作ってないので、telnet で代用。

$ telnet
telnet> open localhost 8080
Trying ::1...
Trying 127.0.0.1...
Connected to localhost.
Escape character is '^]'.
hoge
hoge
fuga
fuga

クライアントから "stop-server" と入力すればサーバが終了する機能はちゃんと動いてるのを確認できた。が、EOF (Ctrl-D 入力でいいんだよなぁ) でのクライアント切断はうまくいかず。Ctrl-D には無反応だった。

以下、今後の課題。

• EOF の問題を解決する (ネットワークプログラミング関係ないけど...)。
• libevent 的なものを使って非同期 IO で多重化する。
• その他なにか思いつけば。

SwingWorker とスレッド数の上限

JDK 6 で追加された SwingWorker は、バックグラウンドスレッドと EDT との通信が必要な場合に非常に有用なクラスで、Swing プログラムを書くときにはよく使う。SwingWorker の詳しい紹介は他の web リソースに任せるとして、今回は SwingWorker を使う上でハマったこと - タイトルにあるようなスレッド数の上限にまつわることを紹介してみる。

SwingWorker は、大体以下のような使いかたをする。

new SwingWorker<Void, Void>() {
  @Override
  protected Void doInBackground() throws Exception {
    heavyTask();
    return null;
  }
}.execute();

このような使いかたであれば、基本的に注意するべき点は (あんまり) ない。問題は以下のような使いかた。

new SwingWorker<Void, Void>() {
  @Override
  protected Void doInBackground() throws Exception {
    try {
      while (true) {
        Thread.sleep(1000);
        if (isCancelled()) {
          break;
        }
        heavyTask();
        publish();
      }
    } catch (InterruptedException exit) {
    }
    return null;
  }
  @Override
  protected void process(List<Void> chunks) {
    updateView();
  }
}.execute();

要約すると、「定期的に起き上がって処理を実行し、ビューを更新する無限ループを実行する SwingWorker」みたいな感じ。ちなみにこんな感じの SwingWorker であっても「普通に」使うぶんには特に問題ない。

じゃあどういうときに問題なのか。それは 2 つ目のような SwingWorker を 10 個以上同時実行したとき。これをやると、実行中の SwingWorker のいずれかを殺すまで、次の SwingWorker の doInBackground が始まらないという問題が起こる。つまりこんな感じ↓

for (int i = 0; i < 10; ++i) {
  new SwingWorker<Void, Void>() {
    @Override
    protected Void doInBackground() throws Exception {
      try {
        while (true) {
          Thread.sleep(1000);
          if (isCancelled()) {
            break;
          }
          heavyTask();
          publish();
        }
      } catch (InterruptedException exit) {
      }
      return null;
    }
    @Override
    protected void process(List<Void> chunks) {
      updateView();
    }
  }.execute();
}
new SwingWorker<Void, Void>() {
  @Override
  protected Void doInBackground() throws Exception {
    heavyTask(); // ここは実行されない
  }
}.execute();

なんでこういう問題が起こるかというと、SwingWorker の execute メソッドの実装が関わってくる。execute メソッドで何をやっているかというと、おおざっぱに言えば「スレッド数の上限が 10 の static な ThreadPoolExecutor に自身を投げる」ということをやっている。つまり SwingWorker の execute メソッドを使うと、同時実行されるタスクが 10 個までという制限をかけられることになる。

ではどうしたらいいのか。要は execute メソッド内で使われている「スレッド数の上限が 10 の static な ThreadPoolExecutor」を使わなければいいだけ。つまり SwingWorker の execute メソッドを使うのではなく、独自に用意した Executor の execute メソッドに SwingWorker を渡せばいいってこと。

Executor exec = Executors.newCachedThreadPool();
for (int i = 0; i < 10; ++i) {
  exec.execute(new SwingWorker<Void, Void>() {
    @Override
    protected Void doInBackground() throws Exception {
      try {
        while (true) {
          Thread.sleep(1000);
          if (isCancelled()) {
            break;
          }
          heavyTask();
          publish();
        }
      } catch (InterruptedException exit) {
      }
      return null;
    }
    @Override
    protected void process(List<Void> chunks) {
      updateView();
    }
  });
}
exec.execute(new SwingWorker<Void, Void>() {
  @Override
  protected Void doInBackground() throws Exception {
    heavyTask(); // ここも実行される
  }
});

これで 10 個以上のタスクを同時にバックグラウンドスレッド上で実行できるようになった。めでたしめでたし。

でも、この方法を使うのは本当に必要な場合だけに絞ったほうがいいだろうとも思う。特に一番最初に示した SwingWorker の使いかただけなのであれば、今回紹介したテクニックは無用ではないかなと。10 個以上のタスクをバックグラウンドで同時実行することなんて、よっぽどだと思うし…。もし仮にそういう状況に (一時的に) 陥ったとしても、それは 10 個のスレッドでがんばって処理してもらえば十分なんでねーかなと。

fsc の速いクライアントを Python で書いた (あんまり変わんなかった)

via: blog.8-p.info: fsc の速いクライアントを Ruby で書いた

やってることはほとんど同じ。Python に焼き直しただけ。socket#send でコマンドを送るときに、改行文字を末尾に入れないといけないというところにはまった。
Scala のインストールディレクトリ (scalaHome 変数の値) は $HOME/apps/scala-2.7.7.final としている。ここは環境によって適当に変えるといい。

#!/usr/bin/env python

import os
import socket
import sys
import re

scalaHome = os.environ["HOME"] + "/apps/scala-2.7.7.final"
def findTmpDir():
  return scalaHome + "/var/scala-devel/scalac-compile-server-port"

portsPattern = re.compile(r"\d+")
def findPort(dir):
  ports = [f for f in os.listdir(dir) if re.match(portsPattern, f)]
  if not ports:
    raise Exception("Failed to find port file.")
  return int(ports[0]), open(dir + "/" + ports[0]).read().strip()

def put(sock, msg):
  sock.send(msg + "\n")

def openSocket():
  port, password = findPort(findTmpDir())
  sock = socket.socket(socket.AF_INET, socket.SOCK_STREAM)
  sock.connect(('localhost', port))
  put(sock, password)
  return sock

def transformArgv(argv):
  dir = [] if "-d" in argv else ["-d", "."]
  return [x if x.startswith("-") else os.path.abspath(x) for x in dir + argv[1:]]

argv = transformArgv(sys.argv)
try:
  sock = openSocket()
except:
  sys.exit(os.system("fsc " + " ".join(argv)))

put(sock, "\0".join(argv))
try:
  print sock.recv(8192)
finally:
  sock.close()

実行結果。まずは普通の fsc から。

$ echo 'object A { def main(args: Array[String]) { println("hello") } }' >hello.scala
$ time fsc hello.scala 

real	0m3.735s
user	0m0.192s
sys	0m0.136s
$ rm *.class ; time fsc hello.scala

real	0m1.373s
user	0m0.208s
sys	0m0.120s
$ time fsc -shutdown
[Compile server exited]

real	0m0.312s
user	0m0.216s
sys	0m0.100s

次に今回作ったやつ。

$ time ffsc hello.scala 

real	0m3.860s
user	0m0.196s
sys	0m0.132s
$ rm *.class ; time ffsc hello.scala 

real	0m1.031s
user	0m0.032s
sys	0m0.004s
$ time ffsc -shutdown
[Compile server exited]

real	0m0.035s
user	0m0.020s
sys	0m0.012s

一発目はともかく、二発目も体感として「ちょっと速くなった」って程度。
このスクリプトって、結局は JVM の起動時間を省略しているに過ぎないから、fsc クライアントの処理のうち JVM の起動時間がどれだけの割合を占めてるかってのが肝心になる。コンパイルを実行する場合には、JVM 起動時間の割合がさほど大きくないから、二発目の結果のように、ぶっちゃければ「あんまり変わらない」結果になる。
逆にコンパイルを実行しない場合には、シャットダウン呼び出しのように 10 倍近い (つまりかなり変わる) 速度になる。これはシャットダウン呼び出しにおける JVM 起動時間の割合が大きいから、JVM 起動時間を省略すればそれだけ大きな影響を与えることに起因してる。

ところで、実際 Scala プログラム書くときには、fsc をそのまま使うことはあんまりなかったりする。実際には sbt なり maven なりを使うことが多い。fsc を使うのは書き捨てプログラムを書くときかなぁ。