並列化したYpsilonVMをsvn trunkで公開しました

ちょっと仕上がり具合を確認してみましょう :)

大きめなテストプログラムということで、すべてがSchemeで書かれているDorai Sitaramさんによる正規表現ライブラリ(pregexp.scm: Portable regular expressions for Scheme)を使うことにします。高レベルなAPIとしてはfutureを使うことにしました。これはJavaのfutureのようにexplicitなタイプで、次のように定義されています。

;; defined in sitelib/concurrent.scm
(define-syntax future
  (syntax-rules ()
    ((_ e0 e1 ...)
     (let ((ans (make-shared-queue)))
       (call-with-spawn
        (lambda () e0 e1 ...)
        (lambda (c)
          (unless (condition? c)
            (shared-queue-push! ans c))
          (shared-queue-shutdown ans)))
       (lambda timeout (apply shared-queue-pop! ans timeout))))))

futureはクロージャを返します。このクロージャを呼び出すことにより同期と結果の取得を行います。

イプシロンのfuture

Ypsilon 0.9.6-trunk/r275 Copyright (c) 2008 Y.Fujita, LittleWing Company Limited.
> (import (concurrent))
> (define f1 (future (list 1 2 3)))
> (define f2 (future (list 4 5 6)))
> (append (f1) (f2))
(1 2 3 4 5 6)
> (define f3 (future (list 7 8 9)))
> (f3)
(7 8 9)
> (f3)
#<shutdown>                                ; *1 
> (define f4 (future (usleep 10000000) 'done))
> (f4 100) ; すぐに！
#<timeout>                                 ; *2
> (f4 100) ; 10秒待ってから！
done
> (future (display "hello\n"))             ; *3
hello

*1 結果が取り出せるのは1回だけです。2回目以降は#が返されます。これにより複数のスレッドが同時に値を取り合っても成功するのは1つだけであることを保証します。
*2 結果を取り出すときにタイムアウトをmsec単位で与えることができます。時間内に結果が出ない場合には#が返されます。
*3 futureは呼びっぱなしでもかまいません。リソースは自動的に解放されます。

準備が整ったところで :D

$ ypsilon
Ypsilon 0.9.6-trunk/r275 Copyright (c) 2008 Y.Fujita, LittleWing Company Limited.
> (import (concurrent) (pregexp) (time))
> (define bench
    (lambda (count)
      (let loop ((i count))
        (let ((ans 
               (pregexp-match 
                "^([a-zA-Z0-9!$&*.=^`|~#%'+/?_{}-]+)@([a-zA-Z0-9_-]+)[.]([a-zA-Z]{2,4})$"
                "hoge@foo.bar")))
          (cond ((= i 0) ans)
                (else
                 (loop (- i 1))))))))
> (time (future (bench 25000)))

error: child thread attempt to modify global variable

irritants:
  (*pregexp-space-sensitive?* #t)

backtrace:
  0  (pregexp-match "^([a-zA-Z0-9!$&*.=^`|~#%'+/?_{}-]+)@([a-zA-Z0-9_-]+)[.]([a-z ...
  ..."/dev/stdin" line 4
  1  (bench 25000)
  ..."/dev/stdin" line 1

エラーになりました。:(

これは前回説明した「子は親のヒープを読むことができるが書くことはできない」という制限に引っかかっているようです。コードを見てみるとpregexp.scmはトップレベルで定義した*pregexp-space-sensitive?*にプログラムのあちこちでset!していることがわかりました。そこでpregexp.scmの中の一行を次のように書き換えます。

;(define *pregexp-space-sensitive?* #t)
 (define-thread-variable *pregexp-space-sensitive?* #t)

ちなみに*pregexp-space-sensitive?*はどのマルチスレッドシステムでも対策が必要ですので注意しましょう :)

以下はdefine-thread-variableの定義です。これは変数をスレッドローカルなパラメータに置き換えるマクロで、identifier-syntaxにより(set! *pregexp-space-sensitive?* ...)も自動的に置換します。

;; defined in sitelib/concurrent.scm
(define-syntax define-thread-variable
  (syntax-rules ()
    ((_ (e0 . e1) e2 e3 ...)
     (define-thread-variable e0 (lambda e1 e2 e3 ...)))
    ((_ e0 e1)
     (begin
       (define temp (make-parameter e1))
       (define-syntax e0
         (identifier-syntax
           (_ (temp))
           ((set! _ x) (temp x))))))))

そして・・・

$ ypsilon
Ypsilon 0.9.6-trunk/r275 Copyright (c) 2008 Y.Fujita, LittleWing Company Limited.
> (import (concurrent) (pregexp) (time))
> (define bench
    (lambda (count)
      (let loop ((i count))
        (let ((ans 
               (pregexp-match 
                "^([a-zA-Z0-9!$&*.=^`|~#%'+/?_{}-]+)@([a-zA-Z0-9_-]+)[.]([a-zA-Z]{2,4})$"
                "hoge@foo.bar")))
          (cond ((= i 0) ans)
                (else
                 (loop (- i 1))))))))
> (time (begin (bench 25000) (bench 25000)))
                  :
;;  5.504072 real    6.612413 user    0.012 sys
> (time (let ((thread1 (future (bench 25000)))
              (thread2 (future (bench 25000))))
          (format #t "  T1 => ~s ~%  T2 => ~s ~%" (thread1) (thread2))))
                  :
;;  2.831894 real    5.60435 user    0.0 sys

realでの性能は並列度1を100%とすれば並列度2では194.36%ということになりました。320Mバイト以上のアロケーションと160回以上のGCが行われていることを考えると、この数値はなかなかのものではないでしょうか :^)

※イプシロンのすべてのソースプログラムは http://code.google.com/p/ypsilon/ にて公開されています。