TLSライブラリのバグ

WebSocketをTLSで使うためにSNIがサポートされてないといけないという話からバグを発見。元々は、wssでアクセスするとフリーズするという話だったのだが、これSNIが問題ではなく単にバグを踏んでいただけだったという話。

問題はTLSのレコードが複数のハンドシェイクメッセージを持つことが可能であることに起因する。現状の実装では1レコード1メッセージを期待していて、複数のメッセージが乗っていた場合2レコード目以降を捨ててしまうというバグである。(単にRFCの読みが甘かったという話でもある。)

これ結構大きめな問題で、設計からやり直しかねぇと思いながら15分くらい考えたらなんとなく隙間を縫っていけそうな解決案が思い浮んだのでメモ。現状レコードで運ばれてきたメッセージはとりあえず一度に全部取得し、その後先頭バイトを見てメッセージの振り分けをしている。ここで、アプリケーションメッセージ以外のメッセージは取得した内容をバイナリポートに変換して扱いやすくしている。

問題になるのは、変換したポートが空になるまで読んでいないことなのだ。1メッセージ読んだ後に1バイト先を見てやりEOFでないならセッションオブジェクトにでも保存しておけば次に読むのはメッセージであるということが分かるのでソケットにアクセスしにいって無限に待つということもなくなるのではないか、という案。レコードを読む部分の処理とセッションオブジェクトの変更のみで残りの部分は特に問題なくいける気がする。

とりあえず、明日試してみることにする。 しかし、原因を追究するためにRFCを読み直したり、パケットログを取ったりといろいろやったが、ほぼ空回りというのが自分らしいというか・・・

SchemeでJSON-RPC

SchemeでRAM over Httpだとさすがに誰得すぎるというのがあったので、まだ需要がありそうなJSON-RPCにw (どちらも仕事で使っているという点は一緒)

最近自社プロダクトでJSON-RPCを使っている外部インターフェースがあることに気づいた。ついでにその機能をテストする必要も出てきて、毎回SoapUIで作られたテスト用のスクリプトを数個走らせるのはたるいので、えいやっと作った。最新のHEADに入ってる。

JSON-RPC自体は仕様がネットで公開されているので、それを参照してもらうとして、実際にSagittarius上で使うと以下のような感じになる。

(import (rpc json) (rpc transport http))

(define request (make-json-request 'someMethod :params #((p1 . 1) (p2 . 2)))

(let-values (((status header response)
       (rpc-http-request "http://somewhere.com/jsonrpc-service" request)))
  (json-response-result response))

たったこれだけ！

JSON-RPC自体は非常に簡単な仕様なので、JSONを読み書きできるライブラリがあれば実装可能。 HTTPはSRFI-106で頑張ればいけるので、その気になればそこそこポータブルな実装でもいけるかもしれない(やる気はない)。

実装した際に一応気にしたのは、トランスポートとメッセージは可能な限り分離するということ。これは(今のところ予定はないが)他のRPC(Message PackとかXML-RPCとか)をサポートする際に自分が楽をしたいため。ただ、現状どちらの実装も一個しかないので上手いこと分離できてるかは多少不安。ついでに、JSONの読み書きに使っているChicken Schemeからの移植JSONライブラリはベクタをマップとして扱うので多少使い勝手が悪い部分もある(主にレスポンスデータの探索等)。まぁmatchが使えたり、メモリ気にしなくていいなら手間がかかる程度ではあるが・・・

実際のコードは実に合計で500行以下くらいなので、こういうのがサクッと作れる位には下地になるライブラリが揃っているということになる。多分に偏りがあるというか、一転集中型で揃っているだけだが・・・

Sagittarius 0.4.8 リリース

Sagittarius Scheme 0.4.8がリリースされました。今回のリリースはメンテナンスリリースです。

修正された不具合

• bytevector-u8-set!が負のインデックスを受付けかつデータを破壊する不具合が修正されました
• マクロ展開でlambdaが未束縛エラーになる不具合が修正されました
• cond-expandがネストした条件を処理できない不具合が修正されました
• bitwise-ior、bitwise-xor及びbitwise-andが0引数を受け付けない不具合が修正されました
• write-emv-tlvが長さバイトを正しくエンコードしない不具合が修正されました

改善点

• bitwise-ior、bitwise-xor、bitwise-and、fxior、fxxor及びfxandのパフォーマンスが改善されました

新たに追加された機能

• bytevector-split-at*及びbytevector-splicesが(util bytevector)に追加されました
• SRFI-106がサポートされました
• CMACライブラリ(rfc cmac)が追加されました
• c-variableマクロが(sagittarius ffi)に追加されました
• QNX (BlackBerry 10)環境でのビルドがサポートされました(x86のみ)
• socket-sendto及びsocket-recvfromが(sagittarius socket)に追加されました

非互換な変更

• let-syntax及びletrec-syntaxの既定の振る舞いがR6RSのものになりました。R5RS/R7RSの振る舞いにするには#!r7rsをつける必要があります。

速度改善

Pure SchemeでCRC32のベンチマークを取った方がいて、ありがたいことにSagittariusも結果に入っていた。

Scheme で CRC 計算の件について、いくつかの処理系で動かして時間を計ってみた。 表の数値は 200MB のデータを対象にしたときにかかった時間。 CRC32 改は値を 16bit ずつに分けて計算するバージョン。 pic.twitter.com/COhgUkOYWv
— (32) 齊藤敦志 (@SaitoAtsushi) August 16, 2013

問題は結果のほうである。後ろから数えた方が早い位置にいる。Sagittariusは最速を目指しているわけではないのだが、(明示してないけど)高速であることも売りにしている。幸いにもソースは公開されていらしたのでプロファイルを取って速度改善に望むことにした。

Fixnumは30ビット幅しかないので(32ビット環境)CRCテーブルの要素ほぼ全てはBignumになると思っていい。これは避けようがないので放置。ざっとソースを見ると(当たり前だが)ビット演算が多用されているので実装を眺める。Fixnum-Bignumの組み合わせの場合にFixnumをBignumに変換してBignum同士で演算するようにしていたので、とりあえずこいつのメモリ割り当てをやめるようにする(ちょこっと改善された)。

次にプロファイルを取る。するとbitwise-xorやたら遅い。実装もまぁ、そりゃ遅いわという感じだったので、ゴリゴリ書き直し。(15%くらい改善)。次いで気になったのでbytevector-u8-refがやたらサンプリングされていた。こんなの単なる配列アクセスだからどれだけ呼ばれてもそんなにあるわけ無いだろうと思ったら実装があほなことをしていたので直す(微々たる改善)。

とりあえず、この段階で既存のものと比較してみた。結果は以下。

$ sash crc.scm

;;  (crc32 data)
;;  121.992214 real    124.3640 user    6.130000 sys

$ ./build/sash.exe crc.scm

;;  (crc32 data)
;;  100.720778 real    101.5090 user    3.6040000915527344 sys

うむむ、まだ遅い。bitwise-xorが処理時間の半分を占めているのでそこの改善がほぼダイレクトに効くのだが、どうやら効かせ方が足りないらしい。

Boehm GCとQNXとBB10と

いろいろ動くようになってきたので多少のメモを含めて。

BB10(Blackberry 10)上でSagittariusを動かせないだろうかというのはそれこそ発売当初くらいから考えていたりする(2月か？)。BB10はQNXをベース(というかOSはQNX)にしたデバイスなのでPOSIX準拠(なはず)。POSIXをサポートしてるんだし、いけるだろう程度にしか考えてなかったのだが、Boehm GCが鬼門であった。

Twitterでも呟いたのだが、Boehm GCの環境依存コードはよく言えば歴史を感じさせる継ぎ足しっぷり、悪く言えば全くもって嫌気がするレベルのコードである。QNX自体は結構歴史あるUNIX系OS(らしい)ので当然サポートされてるだろうなぁ、なんてあまっちょろいことを考えていたのだが、世の中そううまくいくわけはなかった。がっつりパッチを書きました。幸いだったのは、FreeBSD依存のコードとか、OpenBSD依存のコードが結構流用できたので最低限サポートしなければならない部分だけ書けばよかった点かな。最新のHEADはQNX用のBoehm GCのパッチが入ってたりする。できに自身はないので、本家に取り込んでもらおうということは考えていない。

元々はSagittariusのC APIを使って実装しようと思ったんだけど、RIMが提供するIDEでの設定が分からなかったのでbarファイルにsashごと全部放り込んでリモートREPLを立ち上げるというかなり強引な手を使って実現してたりする。ソケット通信なのでセキュリティ等々をもう少し考えないとまずいのだが(俺々証明書作ってTLSで通信するか？)、まぁそれはもう少し後にする。GUIのデザインは正直苦手なのと今一Widgetの融通が利かないのとで多少異常に満足のいかないものになっているのも愛嬌だろう・・・

とりあえず、実装詳細的なもの。

• sashプロセスが立ち上がってもREPLサーバは立ち上がっていない
• 回避するためにサーバが立ち上がったらマークファイル作るようにした
• (exit)を実行するとプロセスごと死ぬ問題
• 死んだことを検地して再起動を促すように
• Qt側のソケットとプロセスの状態をQtのシグナル/スロットで監視
• これ、便利なんだけど、スロット内で他のシグナルを起動するようなことすると意味不明のバグになる
• 既に悩んだ
• しかも、どれがシグナルを送るのか今一わからなかったりするしｗ

ふと思ったのだが、この手法(リモートREPL)で行けば他のモバイルで動かすのも簡単にいけるのではないかと妄想。

以下はTODO

• 起動ポートを設定可能にしたい
• 既に準備はしてある
• 実行履歴があると便利だと思う
• 外部に出す？
• 実機で動かしてみたい
• Blackberry Worldに登録

仕事で山ほどBB7(一つ前のモデル郡の総称)の実機を使ってるのに、BB10の実機はない現実。ここではまだ売ってないので買うという選択肢もないという(まだ北米だけか？もう欧州でも売ってる？買うつもりはないんだけどｗ)。ストレステストみたいなことはしてないので、Boehm GCがまともに動いてるのかは微妙なんだけど(多分動いてると思う)、気になってるのはシミュレータと実機ではCPUが違うこと。実機はARMなんだよね。CPU依存の部分は特に変更なかったと思うから大丈夫だとは思うけど・・・


ということで、だれかBB10ください(違

Porting to BB10

A lot of Scheme implementations are ported to mobile device such as Gambit (iPhone), Mosh(Android), Gauche(iPhone, developing state though). Well, I'm feeling like it's time for me to ride the wave! Unfortunately, I have no developing environment neither iPhone nor Android but Blackberry. So I've so far decided to do with BB10 environment.

First of all, I needed to build Sagittarius on BB10 environment. This wasn't so difficult actually, I just needed to provide proper CMake tool chain configuration and some patches for Boehm GC (which only makes compiler satisfied currently though).

After that, I was trying to use Sagittarius as a library so that the application only needs to do eval and outputs the result. However this wasn't easy for me to handle standard I/Os. On BB10 environment, as far as I know, it is impossible to redirect keyboard input and standard output to GUI panels. So I thought I needed to create custom port to handle these things but I was too lazy to do it. So I've decided to use remote REPL which is already in library.

The basic idea I'm trying to do is really simple. Put all Sagittarius component into bar (Blackbarry ARchive, I guess) file and run the remote REPL as a child process. So what I need to implement is only send user input and receive the result. Then I'm facing a problem that for some reason sash is not executable. So I wrapped with shell which add permission of execution then run it. Now I've got core dump.

What am I missing?

Why I think macro is necessary for programming language!

DRUNKEN ARTICLE CAUTION: the article might not make any sense!

Macro, that is the last resort for all programmers. Macro, it's a sweet temptation. Macro...

Well, if you are familiar with macros and doing job with Java (or any other languages don't have macro), you must be really frustrated like me. I was thinking why I've got so irritated without macros and got a conclusion.

I assume all programmers want to write clean, fast and maintainable code without any inconsistency. Suppose you are a Java programmer and need to write really similar code multiple times and all of the classes are not the same region. In this case, I would create an abstract class or utility class to put all common process in. However I think it's ugly because the abstract class is not the behaviour of the derived class and utility class is not object oriented. Then what is the cleanest and consist way to resolve it? Copy&Paste? I have yet no solution.

If I'm using C++ then I could use template for that situation. It allow me to write common process without creating super class and inject dependency. If I can use Lisp for this situation, this is, I think, the best situation to use macro to avoid code duplication or writing ugly code.

What makes macro so powerful? Well, after writing this I felt I'm so stupid to write such obvious question. If you have written any code, then you must know how powerful modifying source code before it's compiled is. You can feel you became a god or so (not really). So far, I only know the language which allows you to do such free things is only Lisp. It has macro, read macro, reflection, aspect oriented and so on. (Well, even though I listed some other stuff but I'll focus on only macro.) Which other language can make own *syntax* within its language specification?

I know it has also some crappy things like it doesn't allow me to do much things within the specification (Scheme), not so portable between implementations (CL, Scheme) and all. And I think each language needed to decide not to have all *nice to have* features. So everything is trade off but if that's so, I would rather go more comfortable one and to me comfortable means freedom. More precisely, the language which can extend itself if I needed.

Yes, as I expect there is no conclusion nor sense in this article. Don't write something in drunk.

引数の上限

引数の上限を超えるとどうなるだろうと以下の記事を読んで気になった。

Chibi schemeの多値は単に多値オブジェクトで、call-with-values等で明示的に受け取らないと悲しいことになる。もっともChibi schemeのような実装にも、多値の長さに制限がないというメリットがある。nmoshは多値の長さ(= 事実上手続き引数の個数制限)が100程度に制限されている。現状のSchemeではこの制限をクエリする良い方法が無い。

引数個数制限はご無体な気もするが、Cの呼び出し規約のように関数呼び出しをスタック経由で行う規約は基本的にヒープサイズ制限よりもスタック長制限が先に来る。常識的に考えて固定arityの引数が100を越えることは無いので、可変arityの手続きの呼び出し規約をスタック渡しとオブジェクト渡しに分けるのは効果的かもしれない。
[scheme][nmosh] Unspecifiedの数とarity - .mjtの日記復帰計画

まぁスタックサイズに限界はあるわけだし、SEGVのが普通かなぁと思いつつ、以下のスクリプトを用意。

(import (rnrs) (only (srfi :1) iota))

(define-syntax apply-100000-values
  (lambda (x)
    (syntax-case x ()
      ((k)
       (with-syntax (((v ...) (datum->syntax #'k (iota 100000))))
         #'(list v ...))))))

(apply-100000-values)
(display 'ok) (newline)

以下はGauche用

(define-macro (apply-100000-values)
  `(list ,@(iota 100000)))
(apply-100000-values)
(apply-100000-values)
(print 'ok)

でっ、結果。(Chezはiotaを自前実装した。Chibiは低レベルマクロの使い方が分からないので割愛。)

Chez - ok
Gauche - SEGV
Mosh - ok
Sagittarius - 返ってこない(マクロの展開が終わらなかった)
Ypsilon - ok

意外だなぁと思ったのはMoshで、以前valuesに10000以上の個数をapplyするとSEGVるというバグを報告している経験からこけるものだと思っていた。(スタックを壊してる可能性があるので、他の操作をしたら予期しない場所でこける可能性はあるが。)

Chez及びYpsilonはどうして動いているのかは分からない。

Why does this call/cc go into infinite loop?

I've found interesting call/cc stuff in Chaton's Gauche room (this)

The code is this one;

(let ((x 0) (cc '())) 
  (set! x (+ x (call/cc (lambda (c) (set! cc c) (c 1)))))
  (if (< x 4) (cc 2) x))

As far as I investigate, Chez, Chicken, Mosh, Sagittarius and Ypsilon went infinite loop. Chibi and Gauche returned 5. Well I'm not a guy from continuation world so I can't say which is correct. However if the call/cc is located to left hand side, then it won't be infinite loop.

;; This returns 5
(let ((x 0) (cc '())) 
  (set! x (+ (call/cc (lambda (c) (set! cc c) (c 1))) x))
  (if (< x 4) (cc 2) x))

It seems the order of evaluation so I can probably get the answer.

I don't know about other implementations but Sagittarius so following guess is based on its call/cc implementation.

On Sagittarius, continuation is stack and it contains return address. So call/cc captures arguments and return address. Following is the image;

#first one
before call/cc
 +----------+
 |   cont   |
 +----------+ <- captured
 |   pc(+)  |
 +----------+
 |    x=1   | *1
 +----------+
 | pc(set!) |
 +----------+

#second one
before call/cc           after call/cc
 +----------+             +----------+
 |   cont   |             |    x     |   
 +----------+ <- captured +----------+
 |   pc(+)  |             |   c(1)   |
 +----------+             +----------+
 | pc(set!) |             |   pc(+)  |
 +----------+             +----------+
                          | pc(set!) |
                          +----------+

NOTE: pc is return address, cont is call/cc's argument. 
      Stack is growing upwards.

Well it's already obvious but I will describe just in case.The point is *1. The first one, the x is not a box means it's mere value (in this case 1). Then call/cc will capture the stack with the value. So the second call of (cc 2) will always be addition of 1 and 2. Thus it will never be greater than 4. On the other hand, the second case, stack doesn't have x yet so that VM will always compute what is inside of the box (x). Then (cc 2) will always compute the value of x and 2.

I think implementations caused infinite loop are using the similar method to implement call/cc as Sagittarius and Chibi and Gauche use something different. And again, I'm not the those guys from continuation world, so can't say which is correct or not but as my understanding both can be correct and this case is sort of edge case of call/cc.

Bignumの速度改善(調査編)

SBCLがGMPを使うようになったらしく、こんなツイートをもらった。

これで @tk_riple さんの第二次VS SBCL Bignum戦争開幕？
— llibra (@l_libra) July 5, 2013

期待されているなぁ・・・相手GMPだけど・・・

期待されると応えようともがく性分なので、とりあえず現状でどれくらいGMPと差があるのか適当にテストしてみることにした。GMPと言えばMoshが使っているのでここと比較。なぜか？機械語吐き出すSBCLと戦う前に同じバイトコードなScheme処理系のMoshを倒さないとオーバーヘッドの部分で確実に負けることが確定しているから。

テストコードは以下(ここのPython用のをSchemeに移植)：

(import (rnrs) (time))

(define (factorial n stop)
  (let loop ((n n) (o 1))
    (if (> n stop)
        (loop (- n 1) (* o n))
        o)))

(define (choose n k)
  (/ (factorial n k) (factorial (- n k) 0)))

(time (choose 50000 50))
#|
;; Mosh用timeライブラリ
;; time.scm
(library (time) (export time) (import (mosh)))
|#

以下が結果。

% time sash test.scm

;;  (choose 50000 50)
;;  6.536399841308594 real    11.13800 user    1.669000 sys
sash test.scm  11.17s user 1.76s system 194% cpu 6.661 total

% time mosh --loadpath=. test.scm

;;1.4351999759674072 real 1.264 user 0.172 sys
mosh --loadpath=. test.scm  1.28s user 0.20s system 99% cpu 1.482 total

まぁ、分かってはいたのだがここまで差があるのか・・・
SagittariusはBoehmGCがGC用スレッドを持ってるからRealとUser時間が倍違うのか？とりあえずReal時間だけ気にすることにする。

このベンチだと単純に乗算だけなんだけど、とりあえずそこからか・・・先は長そうである・・・

Loop macro for Scheme

The inspiration came from this article's comment: 10.times - Island Life

I'm not a CL user but I sometimes think CL's loop macro is really convenient if I want to write something really small. (I don't think I want to write big stuff with it. It's too complicated to me.) So why don't I write something looks like it?

Here is that something. It doesn't cover whole loop macro but some.

#!r6rs
(import (except (rnrs) for-each map) (only (srfi :1) iota for-each map))

(define-syntax %loop
  (syntax-rules (:for :in :do :repeat :collect)
    ((_ (vars ...) (body ...) op :for var :in l rest ...)
     (%loop ((var l) vars ...) (body ...) op rest ...))
    ((_ (vars ...) (body ...) op :repeat n rest ...)
     (%loop ((tmp (iota n)) vars ...) (body ...) op rest ...))
    ((_ (vars ...) (body ...) op :do expr rest ...)
     (%loop (vars ...) (expr body ...) for-each rest ...))
    ((_ (vars ...) (body ...) op :collect expr rest ...)
     (%loop (vars ...) (expr body ...) map rest ...))
    ;; last
    ;; do trivial case first
    ((_ () (body ...) op)
     ;; infinite loop
     (do () (#f) body ...))
    ((_ ((var init) ...) (body ...) op)
     (op (lambda (var ...) body ...) init ...))))

(define-syntax loop
  (syntax-rules ()
    ((_ clause ...)
     (%loop () () #f clause ...))))

#|
(loop :for i :in '(1 2 3 10) 
      :for j :in '(4 5 6)
      :do (begin (display i) (display j) (newline)))

(loop :repeat 10 :do (begin (display 'ok) (newline)))

(display
 (loop :for i :in '(1 2 3 10) 
       :for j :in '(4 5 6)
       :collect (+ i j))) (newline)
;; (loop :do (begin (display 'ok) (newline)))
|#

I'm not sure if this is useful or not and I don't want to go deep inside of the crucial loop macro specification either, though :-)

NOTE: I've tested above code Racket (plt-r6rs), Mosh, Ypsilon and Sagittarius but Ypsilon raises an exception when the given list length are not the same.

TLSとFTPと

FTPライブラリを書いてたらTLSにバグが混入しているのを発見。しかも、0.4.4から紛れ込んでいたものだったという切ないものだった。まぁ、TLS周りはテストを書いていないので発見しようが無かったという話ではあるのだが、あんまり使わないんだなぁ自分でも・・・テスト大事だよ！(どうテスト書こう、テスト用にサードパーティの何かを入れるのは嫌だが、セキュリティ周りのテストを自家製だけで書くのはまずいし、さてさて・・・)

まぁ、原因はSRFI-6の挙動をポートから取り出してもポートを空にしないように直した際のバグなのだが、何しろ3ヶ月前のこととあまり直接的な原因ではないこともあいまって最初はどこが悪いのかさっぱり分からんかったりした。っで、どう見つけたか？もうね、ローラー作戦ですよ。0.4.3までソースを巻き戻してどこで起きるかというのを一個ずつ潰していくという何とも地味な作戦。0.4.3から0.4.4の間ではBignumのパフォーマンス改善してたのでそこかなと当たりをつけてたらまんまと外れたという、思い込みもよくないという話。

原因が分かれば直すのは簡単で、さくっと直してFTPの実装を再開。データコネクション周りが実は面倒だということが発覚して、どうしようというのが現在直面している課題。

問題になるのはアクティブモードなのだが、クライアント側がサーバソケットを作ってFTPサーバからの接続を待つ必要があるのだが、現状のソケットライブラリでサーバソケットを作るとgetsocketnameで取れるアドレスがループバックアドレス(0.0.0.0)になってしまう。じゃあと思ってAI_PASSIVEを外してやると今度は127.0.0.1が取れるのだが、これって他のサーバとやり取りできないよなぁという感じでごにょごにょしている。(どうでもいいのだが、socket-nameというAPIがあるんだけど、こいつが非常に紛らわしくなっているので変更してやろうと思っていたりする。) 普通にNICに割り付けられたIPアドレスを取る方法ってないのだろうか？

どうでもいいのだが、職場のFTPはFTPSは受け付けていないという事実が分かって驚愕している・・・SFTPじゃないとだめなのかよ・・・orz

ほしいライブラリ

ちょっと開発意欲が低下気味な6月、ほしいものはあるんだけどモチベーションが高まらないというなんともだめな感じである。

とりあえず、何がほしいかをメモっておいて後で頑張ろうという先送り作戦を展開してみんとす。といっても、今のところは2つしかないんだけどね。

【Lexer】
CのヘッダをパースしてFFIのバインディングを吐き出すような何かを作ろうとしているんだけど、Packratという強力なパーサジェネレータはあるくせにLexerは毎回手書きという切ない状態にある。 ということで、Packratで使えるLexerを生成する何かしらがほしい。妄想的に以下のように書けると嬉しいかもしれない。

(define generator
  (lexer
    (D #("0-9"))    ;; vector indicates a charset?
    (L #("a-zA-Z_"))
    ...
    ("/*" comment)  ;; here comment is a procedure takes one argument which is a port?
    ("auto" 'AUTO)  ;; returns token kind?
    ...
    ((/ "[" "<:") '#\[)
    ...))

細かいことは全然考えてないのだけど、とりあえずこんな感じでルールを書いたら適当にLexerを作ってくれる何かしらな感じ。RacketにLexerジェネレータなライブラリがあるから参考にしようかと考えている。(Pure Schemeな実装があったら是非教えてほしいなぁ)

【FTP】
仕事でちょいちょいFTPでwarを上げてJBossにデプロイなんてことがあるんだけど、現状でMavenをSchemeで叩いているのだから出来上がったwarもSchemeで上げてしまえたら一手間減るよなぁと考えている。FTPなんて実装はどこにでもあるわけだし移植するだけなんだけど割りと億劫になっているのと、APIをどうしようとか、TLSなソケットも使えるようにしてFTPSもサポートしないと使い物にならんとか考えていて手が動いていない状態。まぁ、なんとなく構想ができてきている段階ではあるので、テスト用の環境をでっち上げて作るだけではあるのだが・・・

個人的にはIMAPとかあるとiPhoneで音が鳴ったら適当にシェルからメールがチェックできたりして便利かもとか考えていたりはする。まぁ、これは必要に迫られていないので妄想すらないが・・・

Sagittarius 0.4.6リリース

Sagittarius Scheme 0.4.6がリリースされました。今回のリリースはメンテナンスリリースです。ダウンロード。

修正された不具合

•  parameterize内でcall/ccを使うとパラメタの値が正しく復帰しない不具合が修正されました
• パラメタの束縛を変更しても変更が反映されない不具合が修正されました
• define-libraryで(scheme base)をインポートしないとcond-expandが使えない不具合が修正されました
• define-classが他のライブラリに依存している不具合が修正されました
• #x800000がマイナスの値を返す不具合が修正されました
• (sagittarius mop validator)のobservevrがエラーを投げる不具合が修正されました
• 組込み総称関数がSEGVを起こす不具合が修正されました
• current-jiffyが正確な整数を返さない不具合が修正されました
• ((and and))がREPL上でSEGVを起こす不具合が修正されました
• datum->syntaxが正しく構文オブジェクトを作成しない不具合が修正されました
• importがexcept句を無視する不具合が修正されました
• 組込み総称関数が:primary以外のqualifierを持てない不具合が修正されました
• list-sortが第一引数をチェックしない不具合が修正されました
• make-bytevectorの第一引数にマイナスの値を渡すとSEGVを起こす不具合が修正されました
• (clos user)をprefixインポートした際にunbound variable例外が投げられる不具合が修正されました

改善点

• define-c-structが局所的に扱えるようになりました
• FFIがwchar_t*を扱えるようになりました
• c-functionが可変長引数を扱えるようになりました
• MOPがより柔軟になりました
• コンパイラが使用されていないインストラクションを生成しないようになりました

新たに追加された機能

• object->pointer及びpointer->objectが(sagittarius ffi)に追加されました

CLライクな未定義シンボルハンドリング

正直あってもあまり使いどころは無いのだが、面白いことに使えるかなと思い実装してみた。

仕組みはいたって簡単で、総称関数unbound-variableを追加して、VMが未定義シンボルを検出したらそれを呼び出すだけ。デフォルトでは普通に&undefinedを投げるんだけど、たとえばこんなメソッドを追加してやるとCLっぽく動くようになる。

(import (rnrs)
        (sagittarius debug)
        (sagittarius vm)
        (clos user))

(define-method unbound-variable ((name <symbol>) lib)
  (format (current-error-port) "**** unbound variable ~s~%" name)
  (format (current-error-port)
          "use-value   :r1 Input a value to be used instead of ~s~%" name)
  (format (current-error-port)
          "store-value :r2 Input a new value for ~s~%" name)
  (format (current-error-port)
          "abort       :r3 Abort (raise unbound variable error)~%")
  (let loop ()
    (format (current-error-port) "break >")
    (case (read)
      ((:r1) 
       (format (current-error-port) "Use instead of ~a:" name)
       (read))
      ((:r2)
       (format (current-error-port) "New ~a:" name)
       (let ((e (read)))
         (%insert-binding lib name e)
         e))
      ((:r3) (call-next-method))
      (else (newline (current-error-port)) (loop)))))

(print test)
(print test)
(print test)

正直、これがうれしいかといわれると、微妙なところではあるが。使いどころは無いんだけど、REPL上でデバッグするときに便利だろうか？(ただ、あんまり何も考えてないので、この中で例外投げたらどうなるとか全く気にしてなかったりする・・・HEADにあるけど消すかも・・・)

How should include work?

There was a post which asked the behaviour of the include syntax in R7RS. This is the post;

Dybvig's paper about syntax-case, I'm unsure abouttherequirements
of R7RS regarding the use of `include' within macros:

(define-syntax m
   (syntax-rules ()
     ((_) (lambda (a) (include "some/file.sch")))))

where the file "some/file.sch" contains, say,

(+ a 1)

Is the symbol `a' in "some/file.sch" supposed to match the
lambda's argument?

[Scheme-reports] file inclusion (section 4.1.7 of draft 9)

Then R7RS draft 9 says like this;

Both include and include-ci take one or more names expressed as string literals, apply an implementation-specifi c algorithm to find corresponding files, read the contents of the files in the specified order as if by repeated applications of read, and e ffectively replace the include or include-ci expression with a begin expression containing what was read from the files.

So in R7RS include reads from the specified file with read without any syntax information. So, in above case it shouldn't refer the lambda's argument.

Now, John Cowan responded a lot of implementation could see the variable a. Well, yes, this is odd. However I think I know why (only R6RS implementation wise).

Following is the (naive) implementation of the include with R6RS syntax-case

(import (rnrs))
(define-syntax include
  (lambda (x)
    (define (do-include k name)
      (call-with-input-file name
        (lambda (in)
          (do ((e (read in) (read in)) (r '() (cons (datum->syntax k e) r)))
              ((eof-object? e) (reverse r))))))
    (syntax-case x ()
      ((k name)
       (string? (syntax->datum #'name))
       (with-syntax (((expr ...) (do-include #'k (syntax->datum #'name))))
         #'(begin expr ...))))))

The point in R6RS is that syntax-case must always return syntax object so with this implementation, the included expressions wrapped (or converted) by syntax object so that a contains some syntactic information to refer the lambda's argument. (Unfortunately, Sagittarius raises an error with unbound variable. Well, I know it's a bug...)

Then we need to come back to what R7RS says. Yes, it actually doesn't specify but read the file content by read and replace it. Thus, both behaviours can be valid as my understanding.

Now, my big problem is that I need to fix the macro's bug... I thought it could see it but it didn't...

FFIとcallback

最近FFI周りばかり弄っている気がする。取り立てて必要というわけではないのだが、バグが目に付くというか、一貫性の無さが気に入らないというかそんな感じ。

っで、ふとcallbackの実装がメモリ使用量的に嬉しくないことに気づいた。

現状の実装ではcallbackは作られるとSagittariusの静的領域に保存される。これは「呼び出したC関数内でcallback関数が保存された後にGCが走ってcallbackは回収されちゃったけどCから呼び出されちゃった、てへっ♪」って言うのを防ぐためだったりする。FFIで開いた共有オブジェクト内のことはGCは気にしてくれないし、ついでにそこに渡されるcallbackはlibffiが割り付けたメモリなのでそもそもGCはたどることすらできない。

まぁ、callbackなんてそんなに使わないからいいかと言えばいいのだが、たとえばうっかり100万回回るループの中で10個ずつ作成しました！なんてことが起きる可能性が無いわけではない。実際、書く方としてはわざわざ開放してやるなんてことをしたくはないだろう。(推奨してはいないが・・・)

ただ、そうするとどうにかして自動で開放してやる仕組みが必要になるのだが、 どこか見知らぬアドレスに格納されたGC管理外メモリのことなんて知る由もないわけで、いい案どころか無理ゲーな感じが否めない。

なにかしら、適当な落としどころがほしい感じである。

FFIの可変長引数

必要がないのでサボっていたのだがGTKのバインディングをまじめに考えるなら必要になることがわかったのでちょっと頑張って実装してみた。

こんな感じで使える

(import (rnrs) (sagittarius ffi))

(define libc (open-shared-library "msvcrt.dll" #t))

(define snprintf (c-function libc int _snprintf (char* ___)))

(let ((buf (make-bytevector 10)))
  (snprintf buf 10"%d:%s\n" 100 "test")
  (print (utf8->string buf)))

(snprintf) ;; error

まだ実装が適当(与えられる引数の制限が多い)なのと、libffiのバージョンによっては正式にサポートされていないので警告文が出たりする(ぱっとソース見た感じだと特殊な処理が必要なアーキテクチャの方が少ないみたいだし、メジャーどころは要らなさそうなので、デフォルトで警告を出す必要は無いかもしれないが・・・)。

libffiで可変長の引数を扱うのは結構泥臭くて、呼び出し側は全ての引数を把握していないといけないのと、*残り*みたいな引数型はないのでffi_storageを引数個確保しておく必要がある。この制約のせいで通常の関数とは違って多少オーバーヘッドがかかるようになってしまった。

通常はC関数オブジェクトの作成時に必要な領域(引数型情報の配列)を確保しているのだが、可変長の場合は呼び出しごとに作成する必要がある。利便性を取るか速度を取るかといった感じである(ベンチマークとってないのでどれくらい性能に影響を与えるかは分かっていなかったりするが)。

あと、コールバックは可変長に対応していなかったりする。今のところ必要な場面が思いつかないのと、可変長引数を受け付けるコールバックを見たことがないというのが理由。まぁ、単なる手抜きである。

MOP improvement(?)

On Sagittarius,  MOP was not totally compatible with Tiny CLOS's MOP. That's because of my laziness. However I have noticed that once I use non builtin generic class, then it's not possible to use method qualifiers. This is not good to me. So I have improved some stuff.

The problem was that it was only implemented in C code and not in Scheme code so once I used custom generic class then it won't check those qualifiers. So I have removed builtin compute-applicable-method and moved to Scheme. Then implemented all required procedures and duplicated the logic in Scheme. (I actually don't want to do this but so far I couldn't find any better way.)

Now, I can do something like this;

(import (rnrs) (clos user) (clos core) (srfi :1))
 
(define-class <my-generic> (<generic>) ())
(define-generic foo :class <my-generic>)

(define-method compute-applicable-methods ((gf <my-generic>) args)
  (let ((m* (generic-methods gf)))
    (let-values (((supported others)
                  (partition (lambda (m) 
                               (memq (method-qualifier m)
                                     '(:before :after :around :primary)))
                             m*)))
      (for-each (lambda (m) (remove-method gf m)) others)
      (let ((methods (call-next-method)))
        (for-each (lambda (m) (add-method gf m)) others)
        (append others methods)))))

(define-class <human> ()())
(define-class <businessman> (<human>) ())
(define-method foo :append ((h <human>))
  (print "something else")
  (call-next-method))

(define-method foo :around ((h <human>))
  (print "human around before")
  (call-next-method)
  (print "human around after"))

(define-method foo :before ((h <human>))
  (print "human before"))
(define-method foo :before ((b <businessman>))
  (print "businessman before"))
 
(define-method foo ((h <human>))
  (print "human body"))
(define-method foo ((b <businessman>))
  (print "businessman body"))
 
(foo (make <businessman>))
#|
something else
human around before
businessman before
human before
businessman body
human around after
|#

I have no idea what I'm doing in above code!! Well, default implementation of method qualifier refuses non supported keywords so first remove other keywords from generic function then compute builtin qualifiers and adds the removed ones. At last append the non supported qualifier methods in front of the computed ones. The result is the other qualifier one is called first then the rest. If you put this append after the around method then all methods need to call call-next-method otherwise it won't reach there.

I have no idea if I will use this or not but at least I have something if I want to change the behaviour!

総称関数の:beforeとか

ほぼ初めて実用でこの辺の機能を使おうとしてふと不満に思ったこと。

SagittariusのCLOSはXeroxのTiny CLOSの動作を基本にして作られていて、:beforeとかもその動作を元にしている(たぶんこれは以前にも書いた気がする)。っで、ふとそれだとまずいというか、嬉しくないなぁというパターンが出てきて、ちょっと動作のおさらいをしている。

とりあえずは、以下のコード

(import (rnrs) 
        (rename (clos user)
                (define-class %define-class)
                (define-method %define-method))
        (srfi :0))

(define-generic foo)
(define (print . args) (for-each display args) (newline))
(cond-expand
 (mosh
  (define-syntax define-class
    (syntax-rules ()
      ((_ name parents (slots ...))
       (%define-class name parents slots ...))))
  (define-syntax define-method
    (syntax-rules (:before :after :around)
      ((_ name :before (specifiers ...) body ...)
       (%define-method name 'before (specifiers ...) body ...))
      ((_ name :after (specifiers ...) body ...)
       (%define-method name 'after (specifiers ...) body ...))
      ((_ name :around (specifiers ...) body ...)
       (%define-method name 'around (specifiers ...) body ...))
      ((_ name (specifiers ...) body ...)
       (%define-method name (specifiers ...) body ...)))))
 (sagittarius
  (define-syntax define-class (identifier-syntax %define-class))
  (define-syntax define-method (identifier-syntax %define-method))))

(define-class <human> ()())
(define-class <businessman> (<human>) ())
(define-method foo :before ((h <human>)) 
  (print "human before"))
(define-method foo :before ((b <businessman>)) 
  (print "businessman before"))

(define-method foo ((h <human>)) 
  (print "human body"))
(define-method foo ((b <businessman>)) 
  (print "businessman body"))

(foo (make <businessman>))
#|
businessman before
human before
businessman body
|#

まじめに書いてないのでまともに動きはしないのだが、Moshとの互換レイヤが入っている。気になるのは出力結果。動作を合わせてあるので現状は同じ出力を返すのだが、「human before」はcall-next-methodがあった場合にのみに出力されてほしい気がする。というか、そうじゃないと綺麗に書けないコードを書いていて、もにょっている感じ。

本家のCLではどうなっているのかもついでに試してみた(これも以前試したっけ？)

(defclass human () ())
(defclass businessmane (human) ())

(defmethod foo :before ((h human)) (print "before human"))
(defmethod foo :before ((h businessmane)) (print "before businessmane"))

(defmethod foo ((h human)) (print "body human"))
(defmethod foo ((h businessmane)) (print "body businessmane"))

(foo (make-instance 'businessmane))
#|
"before businessmane"
"before human"
"body businessmane"
|#

あぁ、本家もそうなのか。そうなると逸脱するのも微妙だなぁ・・・

CLOS based GUI library

Most of the script I have written so far is command line script and I didn't feel any inconvenience with it. However, sometimes I felt like if there is GUI to do it, it might make my life easier.

So I have decided to write a GUI library using FFI binding (currently working only Windows or Cygwin). There is a huge problem that is I have never written it before so I have no idea what is the best way to do it. After couple of days, I decided to use CLOS based method (named by me :-P).

It's not done yet but the code looks like this;

(import (clos user) (turquoise))

(let ((w (make <frame> :name "Sample" :width 200 :height 200))
      (b (make <button> :name "ok" :x-point 37 :y-point 50)))
  (add! w b)
  (add! b (lambda (action) (print action)))
  (show w))

The library (turquoise) is the GUI library. This piece of code just shows a window contains a button which prints action argument to standard output when it's pressed. The basic idea is using class as a component representation the same as other modern libraries and show thoese classes to users so that they can extend it easily.

I'm not sure if I should make add-component! or add-action-listner! instead of using generic method add!. If you have opinions about it, please let me know.

公用語が英語な会社

この記事が書かれたきっかけ

1. 自分の会社が最近オランダ人を雇っていないと気づく
2. これって募集要項が英語だからじゃね？
3. そういえば公用語を英語にするって表明した会社があったなぁ
4. 募集要項を英語のみにすれば必然的に英語ができるかつ優秀なやつがくるんじゃね？

という流れで、どれくらいの企業が日本人向けの募集要項を英語で出しているのか調べてみた。(ちなみに、自分が今勤めている会社はオランダ語の募集要項は無い。ってか、サイトにオランダ語の選択肢すらない。いいのか、それで？)

楽天とユニクロは有名だけど、他にどこがあるんだろうとまず調査。以下のNaverのページに載っていた公用語を英語にすると発表した企業に限定(昇進に英語必須とか含めると大変だったのでｗ)

楽天とユニクロ以外に「社内英語公用語」を発表している企業様まとめ 

っで以下が結果。

【日本語で募集】
楽天、ユニクロ、日産、SHARP、 日本硝子

【英語で募集】
SMK

SMKはロケールで変わるのかもしれないが、トップページがSMK Japan in Englishに飛ばされたので。日本語ページを見ると日本語の募集要項が載っていた。その他の企業は基本トップページが日本語だった、ひょっとしたら英語ページは英語なのかもしれない。

別に何ということもないのだが、個人的には企業がどれくらい公用語英語をまじめに実践しているかということを外からしる一つの指標になるのではないだろうかと思ったり。もちろん実情は知りようがないし、面接は英語で行われるとかも調べていないが・・・

ついでに、企業がまじめに英語を公用語にしているということは、「英語は話せて当たり前、その上で何ができるの？」というスタンスでいると思うので、「英語話せます」だけでは採用されないということだと思ったりもしている。というか、意思疎通の手段としているわけだからそこを言及すること自体そもそもおかしいわな。

Sagittarius 0.4.5 リリース

Sagittarius Scheme 0.4.5がリリースされました。今回のリリースはメンテナンスリリースです。
ダウンロード

修正された不具合

• define-c-structがアライメントを無視したサイズの構造体を作る不具合が修正されました
• この修正によって(sagittarius ffi)がより正確なアライメントを計算するようになりました
• parameterizeが値を正しく復元しない不具合が修正されました
• (/ 1 -0.0)が+inf.0を返す不具合が修正されました
• sashの-Iオプションがエラーを投げる不具合が修正されました

改善点

• キャッシュファイルがマルチプロセス環境でより安全になりました
• これによりmake -j nでのビルドが可能です
• parameterのメモリ使用量が少なくなりました

新たに追加された機能

• eql sepecializerが組み込みになりました
• open-shared-libraryが共有ライブラリが見つからなかった際にエラーを投げるオプショナル引数を受け付けるようになりました
• generate-secret-keyでDES3の秘密鍵を生成する際に8及び16バイトの鍵を受け付けるようになりました
• lock-port!及びunlock-port!が追加されました(明文化はされていません)
• call-with-port-lockが(util port)に追加されました(明文化はされていません)

新たに追加されたドキュメント

• (dbi)及び(odbc)のドキュメントが追加されました

Should let-syntax family make a scope?

On R7RS ML, there was a discussion for this topic and I'm wondering about it.

On current draft of R7RS, it says 'The let-syntax and letrec-syntax binding constructs are anologous to let and letrec' so I would say it should make a scope. However the reference implementation, Chibi Scheme, doesn't.

Following quote is from the ML:

Please try to keep a grip on the fact that R7RS-small `let-syntax`, like the R5RS version, is a scope rather than being spliced into the surrounding scope. See ticket #48 and WG1Ballot2Results.

From http://lists.scheme-reports.org/pipermail/scheme-reports/2013-May/003439.html

However, seeing this issue from Chibi Scheme, it's not making a scope intentionally.

The reason I'm wondering about it is actually I don't want to make a scope for neither let-syntax nor letrec-syntax. Current compiler checks the mode and switches the path. Well, it's not heavy operation so it won't improve much performance if I remove it (just a tiny bit). However it does make a big change to write some memory efficient code.

Let's say you want to write sort of following code:

#!r6rs
(library (foo)
    (export command1 command2)
    (import (rnrs))
  (letrec-syntax ((define-command
                    (syntax-rules ()
                      ((_ name body ...)
                       (define name (lambda () body ...))))))
    (define-command command1 (display 'command1) (newline))
    (define-command command2 (display 'command2) (newline))))

This only works when you put #!r6rs annotation on the library defined file (I'm talking about Sagittarius). So, if you want to make some keyword argument or so, then you need to remove the annotation and make define-command global binding.

You might say, "as long as you don't export define-command, then it won't harm your code.", well sort of yes. The problem is acutally on cache file. If you define global macros, then cache file must contain it since we can access it without exporting, using with-library macro. (I know it's a back door stuff, but it's sometimes convenient!) However, if we use let-syntax then cache file won't have it because all local macros are already expanded.

On Sagittarius, if you really don't want to export internal macro you need to write it like above in R6RS mode. Then you don't have any chance to use keyword features.

Should I follow Chibi's behaviour or what R7RS (implicitly) says?

パラメタ

面白いというか、目の付け所が鋭いバグ報告が届いた。(面倒なバグとも言う・・・)

具体的な再現コードは以下のようになる。

(import (rnrs) (srfi :39))
(define x (make-parameter 3 (lambda (x) (+ x 3))))
(print (x))
(parameterize ((x 4)) (print (x)))
(print (x))
#|
6
7
9
|#

SRFI-39的にもR7RS的にも最後の9は6じゃないといけない。原因はすぐに分かったんだけど、問題はどう解決するかという部分。

ちなみに、原因はparameterizeとparameterの実装にある。parameterizeはdynamic-windを使って実装されているのだが、afterのthunkが値をセットしなおす際に保存された値が変換されるという悲しいことがおきる(この場合は6が保存されて、6をセットする際に9に変換される)。 まぁ、解決方法は簡単で、after thunkで保存された値をセットする際に、変換を行わなければいい。

言うは易し、行うは難しの典型である。なぜか、そんなAPIが無いからだ。現状ではパラメタはYpsilonの実装を移植したものを使っている。この実装ではパラメタは単なるlambdaである。つまり、その中身にアクセスする方法などないということだ。(もちろん、同様の問題がYpsilonでも発生する。ちなみにChezでも起きた。意外とこのバグはいろんな実装で穴になっているっぽい。)

とりあえずぱっと思いつく解決方法は2つ。

1. パラメタ作成時に直接値を設定できる手続きを作って一緒に保存する
2. せっかくobject-applyがあるんだし、CLOSで実装してしまう

1の方法だと使用するメモリの量が不安になる、単純計算でパラメタ作成にかかるメモリコストが倍になる。
2の方法だとパラメタを呼び出すときのオーバヘッドが気になる。なんだかんだで総称関数の呼び出しは現状では重たい。

さて、どうしようかな。

eql specializer

This article is continued from the previous one (in Japanese).

Sagittarius has the library to do eql specializer however it was a bit limited if I wanted to use it from C level. So I wanted it builtin, yes I made it :)

Basically almost nothing is changed to use just it became a bit convenient. So you can write it like this (without (sagittarius mop eql) library);

(import (clos user))
(define-method fact ((n (eql 0))) 1)
(define-method fact ((n )) (* n (fact (- n 1))))
(fact 10) ;; -> 3628800

Now you don't have to define a generic procedure before defining methods.

Current implementation is simply ported from the old library so it might not be so efficient. (Well, it's written in C now so it should be faster than before!)


Ah, I thought I wanted to write more but guess not :(

暗号ライブラリの不満

Sagittariusは自前で暗号ライブラリを持っているのだが、ちょっと不満が出てきた。何が不満かと言えば、DES3の鍵生成で必ず24バイト要求するというものだ。これだといわゆるDES2が使えなくて、でも16バイトの鍵がわたってきた場合に困ることになるというもの。

現状では秘密鍵の生成は以下のようにして鍵オブジェクトを作ってやる必要がある。

(import (crypto))
(generate-secret-key DES3 #vu8(...)) ;; must be 24 byte bytevector

generate-secret-keyは総称メソッドなので、DES3がわたってきた際に特異なものを作ってやればいいという話になる。

本来ならという注釈がつくのがポイント。ドキュメントにちょろっと書いてあるのだが、この鍵アルゴリズムの名前は専用のクラスを作って唯一のオブジェクトを登録するのが望ましい、と書いてあるだけだったりする。つまり、なんでもいいのである。 (今思ったのだが、なんでオブジェクトを作る必要があるんだ？クラスだけでもいいんじゃね？) っで、その裏ルールに則って組み込みの秘密鍵なアルゴリズムは文字列が登録されていたりする。(これはバックエンドで使っているLibTomCryptoが文字列でディスクリプタを登録しているため)

そんなときのためにeql-specializerがあるんじゃないかとも思ったのだが、こいつは組み込みではサポートしていないので総称メソッドの定義時にメタクラスとして指定してやる必要があってうまくいかない。

解決方法はとりあえず思いつく中でスマートなものは以下の2つ。

1. RSAと同様に秘密鍵のアルゴリズムも文字列じゃない何かにする
2. eql-specializerを組み込みでサポートする

1.はクラスの階層を考えたり、現在サポートしている全てのアルゴリズムに適用する必要があったりでひたすら面倒だけど王道な解決策。
2.はどこと無くadhocな感じはするが、eql-specializerが組み込みに出来るチャンスともいう。

さて、どっちにしようかな・・・

FFI周りの改善

SagittariusのFFIでCの構造体を定義する際にメタな情報を付与してユーザーにアライメントの計算を強いないようにしている。ここまでは単にユーザーフレンドリな仕様で済むんだけど、内部のアライメント計算処理があまりにも適当すぎて32ビットと64ビットでの違いが吸収できてないとか、オフセット計算が間違ってて特定のメンバにアクセスするとSEGVるとかのバグがちらほらあった。

個人的にあまり問題にしていなかったのだが(Cの構造体を弄る場面が少なかった) 、なんとなく隙間の時間があったので「えいやっ！」と直すことにした。

0.4.4以前で問題になるのは以下のようなコード。

(import (sagittarius ffi))
(define-c-struct foo
  (int   i0)
  (char  c)
  (short s)
  (int   i1))
(size-of-c-struct foo)

定義された構造体のサイズは12(sizeof(int) == 4)でなければならないが、0.4.4では11を返す。これは、構造体のパディングとサイズの(意図的ではないが)ルールを無視しているためだったりする。また、メンバのオフセット計算もおかしかったりで、複雑な構造体を扱うのは危険だったりもした。(メンバが全部intとかvoid *もしくは型が違ってもサイズが同じとかなら問題はない。)

とりあえず、以下のWikipediaのページを参考にしつつ、もうちょっとまともな計算をするように改善。
http://en.wikipedia.org/wiki/Data_structure_alignment
現在のHEADではかなりまともな計算をするようになっている。(個人的に怪しい部分はあったりするが・・・)

また、define-c-structの定義をちょっと変えて、アクセサを同時に定義するようにした。たとえば上記の構造体なら以下のアクセサが自動的に定義される。

foo-i0-ref
foo-i0-set!
 ...
foo-i1-ref
foo-i1-set!
;; 参考 foo-i0-refとfoo-i0-set!の定義イメージ
(define (foo-i0-ref p)
  (c-struct-ref p foo 'i0))
(define (foo-i0-set! p v)
  (c-struct-set! p foo 'i0 v))

実際には内部構造体のメンバを扱うためにオプショナル引数を受け付ける。このオプショナル引数は個人的には美しくないと思っているので(特に-set!側)、なんとかしたいのだがいい案が思いつかない。

さらに、構造体の定義内に配列を含めた際の参照と代入が(ほぼ全く)サポートされていなかったのでそれも直した。配列で定義されたメンバの参照をすると現在はベクタを返すようになっている。代入もベクタで行う必要がある(以前は代入は自前でオフセット計算してやる必要があった)。

個人的にこの辺の機能を使うことがほとんどないので、誰かハードに使ってくれる人を募集してますｗ

Yet Another Syntax-case Explanation

Unlikely my (own) rule, this article is in Japanese (if you want it in English, please comment so).

世の中syntax-caseの解説なんて(たぶん)山ほどあるだろうけど、もう一つGoogleの検索結果を汚してやろうという話。

この記事のsyntax-rulesは使えるけど、syntax-caseとwith-syntaxを絡めて使えないという方をターゲットとしてます。マサカリ大歓迎ですw

【syntax-caseって】
まずは、簡単にsyntax-rulesとsyntax-caseの違いを見てみよう。

(import (rnrs))
(define-syntax print-rule
  (syntax-rules ()
    ((_ o o* ...)
     (begin (display o) (print-rule o* ...)))
    ((_ o)
     (begin (display o) (print-rule)))
    ((_) (newline))))

(define-syntax print-stx
  (lambda (x)
    (syntax-case x ()
      ((_ o o* ...)
       #'(begin (display o) (print-stx o* ...)))
      ((_ o)
       #'(begin (display o) (print-stx)))
      ((_)
       #'(newline)))))

どちらのマクロも同じことをします。これだけ見れば、違いは以下ぐらい：

• syntax-rulesがsyntax-caseになった
• lambdaで囲まれて、syntax-caseの引数(と呼ぶのもおかしいが)にlambdaの引数が渡った
• テンプレート部分がsyntax (#')で囲まれた

はい、この程度のものを書くならsyntax-rulesだけで十分です。じゃあ、syntax-caseを使うと何が嬉しいのか見ていきましょう。

【低レベルな操作】
何を持って低レベルとするのかはさておき、ここでは与えられて式の内容を操作することを低レベルと呼びます。syntax-rulesでは式の変形はできても、中身を操作することはできません。たとえば以下のようなコードは、syntax-rulesでは実現不可能です。

(define-syntax define-foo-prefix
  (lambda (x)
    (define (add-prefix name)
      (string->symbol 
       (string-append "foo-" (symbol->string (syntax->datum name)))))
    (syntax-case x ()
      ((k name expr)
　　　　　　;; need datum->syntax to compliant R6RS
       (with-syntax ((prefiexed (datum->syntax #'k (add-prefix #'name))))
         #'(define prefiexed expr))))))

(define-foo-prefix boo 1)
foo-boo ;; -> 1

さて、ここでwith-syntaxが出てきました。こいつが何をしているのかの説明がこの記事のメインなのでここで解説です。

構文的なものはR6RSでも見てもらえばいいとして、何をしているのか。名前が示すとおり、with-syntaxは新たに構文オブジェクトの束縛を作ります。 ここでは、prefixedがそれにあたります。なぜこんなことが必要かといえば、syntax-caseのテンプレートは構文オブジェクトを返す必要があるからです。そして、syntax (#')構文内では構文オブジェクトの束縛のみが参照可能ということも大きな要因です。上記のような、低レベルな操作を健全なマクロで行うためにあるといっても問題ないでしょう。

また、with-syntaxで作られた構文オブジェクトが保持する情報も重要になってきます。R6RSではテンプレート部分にどこにも定義されていない名前が出てくると、それはユニークな名前に変更されます。define-valuesなどの定義で、dummyとか使われているあれです。しかし、with-syntaxで束縛された構文は束縛された名前がそのまま使えます。

いまいちイメージがつかめない方のために、R5RSとCommon Lispのマクロの議論でよく引き合いに出されるaifをwith-syntaxを使って書いて見ましょう。こんな感じの定義になると思います。

(define-syntax aif
  (lambda (x)
    (syntax-case x ()
      ((_ pred then)
       #'(aif pred then #f))
      ((k pred then else)
       ;; ditto
       (with-syntax ((it (datum->syntax #'k 'it)))
         #'(let ((it pred))
             (if it then else)))))))
(aif (memq 'a '(b c a e f)) it 'boo) ;; -> (a e f)

aifはpred部分の評価結果を変数itに暗黙的に束縛します。なので、マクロユーザからはその定義は見えず、いきなり現れたように見えます。Schemer的にはいまいち気持ち悪い気もしますが、あれば便利な機能です。
ここで使われているwith-syntaxが何をしているかといえば、シンボルitを構文オブジェクトに変換してテンプレート内で参照可能にしています。このitはリネームされないため、あたかも突如現れたかのように使うことができるのです。

【それ、quasisyntaxでもできるよ？】
はい、できます。with-syntaxとquasisyntaxはほぼ同等の力を持っていると思っていいです。なので、上記の例は以下のように書き換えることが可能です。

(define-syntax define-foo-prefix
  (lambda (x)
    (define (add-prefix name)
      ;; ditto
      (datum->syntax name
       (string->symbol 
 (string-append "foo-" (symbol->string (syntax->datum name))))))
    (syntax-case x ()
      ((_ name expr)
       #`(define #,(add-prefix #'name) expr)))))

(define-syntax aif-quasi
  (lambda (x)
    (syntax-case x ()
      ((_ pred then)
       #'(aif pred then #f))
      ((k pred then else)
       ;; ditto
       (let ((it (datum->syntax #'k 'it)))
       #`(let ((#,it pred))
           (if #,it then else)))))))

どちらの方がいいかはユーザの感性に寄るとは思いますが、個人的にはwith-syntaxを使った方が綺麗かなぁと思います。quasisyntaxはCommon Lispのマクロを連想させるという理由だけなのですが・・・。ただ、あまりに多くの構文を導入する必要があると無駄に長くなるという弊害もあるので、ケースバイケースで使い分けるのがいいでしょう。

追記：
Twitterで早速突っ込みが入ったのでdatum->syntaxで明示的に構文オブジェクトに変換するようにコードを修正。SagittariusとYpsilonはこの辺多少チェックがゆるい。
それに伴って多少文言の修正。with-syntaxは構文オブジェクトを束縛する等々。

SRFI-111

今一なんの意味があるのかよく分からないSRFIなんだけど、実装するのが非常に簡単だから実装してみた。こんな感じ。

(library (srfi :111 boxes)
    (export :export-reader-macro
     box box? unbox set-box!)
    (import (rnrs)
     (clos user)
     (sagittarius)
     (sagittarius reader))

  (define-class <box> ()
    ((value :init-keyword :value :reader unbox :writer set-box!)))
  (define-method write-object ((b ) port)
    (format port "#&~s" (unbox b)))
  (define (box? o) (is-a? o ))
  (define (box o) (make  :value o))

  (define ctr #'box)
  (define-dispatch-macro #\# #\& (box-reader port c param)
    (let ((datum (read port)))
      `(,ctr ',datum)))
)

(library (srfi :111)
    (export :all :export-reader-macro)
    (import (srfi :111 boxes)))

要求されているリーダーマクロまで入っているという優れものw
こんな感じで書ける。

#&abc              ;; -> #&abc
(unbox #&abc)      ;; -> abc 
(set-box! #&abc 1) ;; -> #<unspecified>

リーダが読み込んだBoxはimmutableが好ましいとは言われているけど、 そこは気にしない。とりあえず手元にある処理系でこのリーダーマクロをサポートしてるのはRacketのみだったという事実もあったりする。

参照実装がR7RSのライブラリ形式を使っているのも面白い。まだ決まってないけど・・・(まぁ、ここからこけるということもないんじゃないかなぁとは思っているが)

脱BoehmGCへの道 実装編(4)

あきらめてはいないという意思表示ｗ

いや、実際あきらめてなくて、未だに戦ってるんだけど、これ書くということはどうしようかなぁという問題が発生したということでもある。

問題は、あるオブジェクトAの中にあるオブジェクトBがAより後に回収された際に起きるアドレス更新の問題。(ひょっとして#3でも同じ問題を扱ったかもしれない。)
具体的にはユーザー定義のクラスAが同じくユーザー定義のクラスBを基底クラスとして持っていた際に、Aが先に回収されるとAのクラスタグであるBが古いアドレスを指したままとなりさまざまな場面でSEGVを発生するという問題になる。具体的にこれを発生させるコードは以下のようなの：

(import (clos user) (sagittarius control)
        (sagittarius mop validator))
(define-class <person> (<validator-mixin>)
  ((name   :init-keyword :name)
   (gender :init-keyword :gender
           :validator (lambda (o v) (or (memq v '(male female))
                                        (error 'boo))))))
(define-class <business-man> (<person>)
  ((job    :init-keyword :job)))
(let ((man (make <business-man> :name 'john :gender 'male :job 'neet)))
  (dotimes (i 10000) (make-vector 1000))
  (print (slot-ref man 'name))
  (print <person>)) ;; Boom!!

<person>が持ってる<validator-mixin<が回収されても更新されないので出力しようとした際に不正なアドレスを指して死亡する。 こういうのが発生するとクラスタグみたいなのは単なるタグにしておけばよかったと後悔するのだが、これはこれべ便利なので泣かない・・・

うまい解決方法が思いつかないのだが、タグに使われているクラスがGC対象のスペースにあった場合は先に回収してしまうという荒業でいけるだろうか？ただ、scavengeが後で呼ばれることになるのでその際に既に移動してるって怒られる気がするんだよなぁ。 まぁ、とりあえず試してみるか・・・

R7RS ratification vote

The reason why this is English article is simply I don't know the proper translation of  'ratification vote' and felt it's awkward to write it in hiragana or katakana. Sorry, my bad :)

The ratification vote has been started. I'm not quite sure if I will vote or no and if I would, I would vote to 'yes' that's because Sagittarius has whole functionalities, not because I totally agreed with it.

Nobody expects 100% agreement, I believe, probably 70 to 80%. However mine is much lower than it. The reason is it's not stepping forwards but backwards. These are the stuff I think R7RS went backwards from R6RS.

[Low level macro]
A lot of *pure* Schemer think syntax-case is too huge to be in the specification. Actually I totally agree with it (well, that's because it was really hard to implement but as user's perspective it's really convenient). However, R6RS at least put low level hygiene macro in it. I think that's a big step forward. On the other hand, R7RS simply removed it without alternatives. I know it is hard to decide which low level hygiene macro should be in. And now we don't have any way to make R7RS macros compatible with R6RS macros except syntax-rules.

I'm following the discussion since 2011 (I guess) and probably missed why they dropped it without any alternatives. But I can guess the reason, low level hygiene macro is too big to put in RnRS so they probably thought let WG2 handle this. It might be a clever decision but since we already have it, then it is definitely not the best decision, that's because implementations don't have to implement all of libraries defined in WG2.

[Library syntax]
I agree R7RS library syntax much more flexible and convenient than R6RS one. However that simply made existing R6RS libraries not to be able to run in R7RS implementations. As far as I know, currently only 2 implementations are fully implemented with R7RS, Chibi Scheme and my Sagittarius (if you know other, please let me know. I want to try). And Chibi only supports R7RS library syntax means it can't use useful R6RS libraries (like industria or so, before you say 'is there such a library?' :P).

They were probably aiming to use R5RS codes on R7RS implementation easily, like SSAX or so. However, I'm doubting if it was a better way. I don't know why they needed to introduce the brand new  syntax instead of using the existing one. For me, it seems they simply didn't like R6RS or maybe try not to make any confusion.

[Reader macro]
As you already know, reading R6RS source code might not be possible on R7RS implementation because of the difference of bytevector lexical syntax. I totally have no idea why they changed this. I know it's different from SRFI-4 but SRFI is not a specification. Not all Scheme implementation has extensible reader macro like Common Lisp so this simply breaks capability even just reading S-expression file written by R6RS implementation. Honestly, this totally sucks!

I've been feeling that R7RS was for people who didn't agree with R6RS or even hate. I know that's not true. I believe the Scheme spirit is not dropping off the necessary functionalities nor reminiscing good old days. But why R7RS looks like this? Or maybe that's because I'm not a pure Schemer?

At least there are loads of good stuff, one of them is implementing R7RS Scheme would be much easier than implementing R6RS one. So there would be loads of Scheme implementations again :P

Sagittarius 0.4.4リリース

Sagittarius Scheme 0.4.4がリリースされました。今回のリリースはメンテナンスリリースです。
ダウンロード

修正された不具合

•  sqrtに巨大数を与えると非正確数が返される不具合が修正されました
• (atan 0.0)がエラーになる不具合が修正されました
• string-scanが不正な値を返す不具合が修正されました
• get-output-string及びget-output-bytevectorから一度しか値が取り出せない不具合が修正されました
• UTCタイムオフセットがマイナスの地域でcurrent-dateがエラーを投げる不具合が修正されました
• aproposが動作しない不具合が修正されました

 改善点

• 巨大数のexptのパフォーマンスが改善されました

新たに追加された機能

• shared-object-suffix及びset-pointer-value!手続きが(sagittarius ffi)に追加されました
• dbi-fetch-all!に既定処理が実装されました
• key-check-value手続きが(crypto)に追加されました
• ->tlv及びread-tlv手続きが(tlv)に追加されました
• 64bitと32bitの識別子がcond-expandで使えるようになりました

TLVの構築

職業柄TLVとかスマートカードとかよく使うのだが、使う割りにパースするだけで構築するのが無かったので作ることにした。とりあえず現状で必要だったのはAPDUのデータの部分に必要なTLVの構築。

というか、作った。以下のように使える。

(import (tlv))

(->tlv '((#xC9 (#x4F . #xA000000310) ;; AID的な何か
               (#xA0 1 2 3 4))       ;; この行は適当
         (#xEF)))                    ;; タグEF 長さ0の値
;; -> (#<tlv :tag C9> #<tlv :tag EF>)
;;    => C9 0D 4F 05 A0 00 00 03 10 A0 04 01 02 03 04 EF 00

;; バイトベクタに変換するのはちと面倒だけどこんな感じ
;; tlv-list->bytevector作った方がいいかな？
(bytevector-concatenate (map tlv->bytevector (->tlv '(...))))

一応以下のようなS式を受け取ることができる。

tlv-list      ::= (tlv-structure*)
tlv-structure ::= (tag . value)
tag           ::= <integer>
value         ::= ((tlv-structure)*) | <bytevector>
               |  <integer>    | octet*

値部分のオクテットと整数はそれぞれu8-list->bytevector、integer->bytevectorでバイトベクタに変換される。正直これの必要性を今のところ感じていない。半分くらい勢いで入れてしまった。

実装してて思ったのは、TLV形式とS式の親和性は抜群にいいということ。まぁ、バイナリ版XMLみたいなもの(というと大分違うが、柔軟性という意味)なので、なんとなく分かっていたことではある。

自分以外にこのライブラリを使う人がいる気がしないのがポイントだろう。みんなもっとSchemeでスマートカードの操作をするべきである(暴言)

健全なマクロ

探せば山ほど解説があるので、今更というかGoogle検索の妨害するだけな気がするけど。

Twitterで健全マクロの実装をされている方がいて、そういえばコンパイラの環境を重点に置いた解説記事ってあったかなぁと思ったのがきっかけ。たぶんどこかにあるだろうけど・・・

まずは以下のコードを考える。

(import (rnrs))
;; from Ypsilon
(define-syntax define-macro
  (lambda (x)
    (syntax-case x ()
      ((_ (name . args) . body)
       #'(define-macro name (lambda args . body)))
      ((_ name body)
       #'(define-syntax name
           (let ((define-macro-transformer body))
             (lambda (x)
               (syntax-case x ()
                 ((e0 . e1)
                  (datum->syntax
                   #'e0
                   (apply define-macro-transformer
                          (syntax->datum #'e1))))))))))))

;; hygiene
(let ((x 1))
  (let-syntax ((boo (syntax-rules ()
                      ((_ expr ...)
                       (let ((x x))
                         (set! x (+ x 1))
                         expr ...)))))
    (boo (display x) (newline))))

;; non hygiene
(let ((x 1))
  (define-macro (boo . args)
    `(let ((x x))
       (set! x (+ x 1))
       ,@args))
  (boo (display x) (newline)))

;; expanded
(let ((x 1))   ;; frame 1
  (let ((x x)) ;; frame 2
    (set! x (+ x 1))
    (display x) (newline)))

;; frame 1
'(((x . 1)))

;; frame 2
'(((x . x))  ;; *1
  ((x . 1)))

話を簡単にするために、環境フレームは変数と値のペアをつないだもの(alist)とする。まぁ、多くの処理系がこの形式を使ってると思うけど。健全なマクロと非健全なマクロそれぞれの展開形はどちらも同じに(というと嘘が入るが)なる。コメントのframe 1及び2はその下にあるコンパイル時の環境フレームのイメージを示している。

ここで問題にするのは*1がそれぞれの場合で何になるかということ。

健全なマクロではマクロ内で定義された変数をマクロ外から参照することはできない。なので展開後の式とframe 2の環境イメージは実際には以下のようになる。

(let ((x 1))
  (let ((~x x))
    (set! ~x (+ ~x 1))
    (display x) (newline)))
;; frame
(((~x . x))
 ((x . 1)))

実際にどうなるかは処理系によって違うので、上記はあくまでイメージ。ここで問題になるのはletで束縛される変数のみがリネームされるということ。値の方は一つ上の環境フレームから参照されなくてはならない。(正直、これが実装者泣かせな部分の一つだと思っている。)
これの解決方法は僕が知っているだけで2つあって、1つは多くのR6RS処理系が取っている(Sagittarius以外はそうじゃないかな？)マクロ展開フェーズを持たせること。もう一つはSagittariusが取っているマクロ展開器が実行時環境とマクロ捕捉時環境の両方を参照する方法(正直お勧めではない)。

最初の方法だと、マクロ展開器は何が変数を束縛するかということを知っていなければいけない。 そうしないと上記の例のように変更してはいけないシンボルまでリネームしてしまうことになるからだ。値側のシンボルも実はリネームされるんだけど、マクロ束縛時の環境フレーム(frame 1)を参照して外側のletで束縛されたシンボルを見つけて同じ名前にするということが行われる。

2番の方法だと、マクロ展開器は両方の環境を適切に参照しつつ、コンパイラも変数の参照時に多少トリックが必要になる。正直書いててバグの温床にしかならないなぁと思ったのでお勧めではないが、この方法ならマクロ展開器は何が変数を束縛するかということを知らなくてもいいので、重複コードが多少減る。

ただ、どちらの場合もsyntax-rulesを実装するだけならたぶん必要なくて、Chibi Schemeのようにsyntactic closureを使ってer-macro-transformerを実現するとかでなんとかなる。(syntactic closure自体の実装で環境の束縛とか参照が必要にはなるけど、上記ほど複雑にはならない・・・はず。)

非健全なマクロではシンボルはリネームされないので、例で上げた展開後フォームそのままとなる。CLだと上記のようなマクロをSchemeのように動かしたいなら(gensym)とかwith-unique-namesとかを多用する必要がある。Lisp-2だったらたぶんそれでもいいだろうけど、Lisp-1だと泣けるだろうなぁと思う。

思ったとおり普通のマクロ解説記事の劣化版になってしまった。

OCI binding

If you are a professional programmer, then you can't avoid Oracle (or you need to be really lucky). I'm also one of them.

I was using either GUI (mostly Quantam DB) or Sagittarius ODBC binding. Both have some problems but by now it worked pretty fine for me. The reason I've decided to write it was it's getting annoying to use some thing not supporting to dump BLOB data thoroughly or requiring to configure connection setting somewhere difficult to find.

As you already knew, there is the API to use Oracle directly called OCI (Oracle Calling Interface). Well, since I have FFI then why not write a binding for it? It would make my life much easier than now. I was really hoping like that. If everything would have gone well, I wouldn't have written this article. Yes, I've met THE problem.

If you have an experience using ODBC, then you might have thought like this: 'this API requires cast no matter what'. OCI also has this and I call it problem. When this become a problem is actually certain situations such as binding parameters. Sagittarius converts input Scheme object to relevant C object. However it doesn't support casting. So at this point, my motivation had disappeared.

Then it revived like phoenix. My FFI doesn't support cast however most of the values can be converted to bytevector (it can be done by R6RS). Now I have got some lights to go through this crappy API jungle (it's well designed actually).

脱BoehmGCへの道 実装編(3)

ちょぼちょぼ動くようになってきたのだが、やはり一筋縄ではいかないなぁと言うのが正直な感想。

とりあえず現状で問題になっているもの。

1. eq?なハッシュテーブル
2. 昇格された領域にあるオブジェクトから参照されているオブジェクトの移動

1.はシンボル等のアドレスが変わると起きる問題。とりあえず急場でGC中に見つけたテーブルを全てリハッシュをするようにしたけど、これだと何の移動も起きなかったテーブルも影響するし、見つけられなかったテーブルは大変なことになる。けど、うまいやり方が思いつかない。

2.は昇格したオブジェクトから参照されているオブジェクトが移動した場合に起きる問題。とりあえず、理解を整理するための図が以下：

             Eden              |             Survivor
+------------------------------+------------------------------------+
|                              |             obj B                  |
|                              |            +-----+                 |
|             +----------------+------------+--*  |                 |
|        +----+----+           |            +-----+    +-------+    |
|        |  obj A  |           |            |  *--+----+ obj C |    |
|        +---------+           |            +-----+    +-------+    |
+------------------------------+------------------------------------+

obj Bはまぁ配列でも構造体でもなんでもいいんだけど、要するにポインタを格納するオブジェクト。っで1回目のGCで生き残って昇格したんだけど、次のGCとの合間に若い世代のオブジェクトobj Aを内に宿すことになったと。(具体的にはコードベクタが参照する識別子のルックアップを終えてglocを対象の場所に入れるとこれが起きる。まぁ、他にもあるだろう。)

っで、GCが起きると困ることになる。だれが移動先を解決するのかと・・・

実際はこの手のものはある程度解決されてるんだけど、どうも見逃しがあるっぽい。

コードベクタはクロージャとVMで同じものが共有されてるから、クロージャ側だけ更新してやればいいはずなんだけどなぁ、何を見落としてるんだろう・・・

詳解SBCL - Genesis

今日が土曜だということをすっかり忘れて「明日書く」なんて書いてしまった。自分の言動を曲げるのは好きじゃないので、家事の合間の時間で書く(土曜は以外にも忙しい)。

 GenesisとはSBCLがビルド時に生成するCコードのことだと思えばいい。実際にビルドプロセスを走らせると、src/runtimeディレクトリ以下にgenesisディレクトリが作成され、Lisp構造体からconfig.hまで必要な設定が生成される。要するにconfigureスクリプトである。

ビルド時に生成するなら設定とか環境依存の値だけでもいいような気がするが、なぜLispオブジェクトの構造体まで生成するのだろうか？

この辺実はまじめにソース(及びコメント)を読んでいないので推測の域を出ないのではあるが、たとえば世代別GCで使われているgeneration構造体あたりのコメントがなぞを解く鍵になるだろう(大げさ)。要約すると、コメントには以下のような記述がある。

注意：これの変更をしたら、Lisp側のコードも変更するように！もしくはそこにあるFIXMEに書かれてるようにしてくれ。

っで、FIXMEを見る。

 注意：GENERATION(とPAGE)はLisp内で定義されてGenesisでヘッダーに書き出されるべきだ。こことgencgc.cで二重定義なってやがる。

まぁ、要するにランタイム以外の部分って全部Lispで書かれてるから、メンテナンス性を考えると一箇所で定義した方がいいよねって理由だと思う。

これだけだと、「ふ～ん」で終わりそうなので(いや、実際書くほどのことはないのだ)、世代別GCに関係するGenesisを多少紹介。src/compiler/x86/parms.lispにLispオブジェクトが割り当てられるヒープ領域がある。定義はこんな感じ。

#!+win32   (!gencgc-space-setup #x22000000 nil nil #x10000)
#!+linux   (!gencgc-space-setup #x01000000 #x09000000)
#!+sunos   (!gencgc-space-setup #x20000000 #x48000000)
#!+freebsd (!gencgc-space-setup #x01000000 #x58000000)
#!+openbsd (!gencgc-space-setup #x1b000000 #x40000000)
#!+netbsd  (!gencgc-space-setup #x20000000 #x60000000)
#!+darwin  (!gencgc-space-setup #x04000000 #x10000000)

!gencgc-space-setupはsrc/compiler/generic/parms.lispに定義がある。第一引数はスモールスペースのアドレス(どこで使われてるかは確認してない)、第二引数が動的領域の開始アドレスである。これはX86の固有設定だが、他のアーキテキチャにも同様の定義があり、固定値を使っている。

合計4つになるとも思ってなかったけど、これをきっかけにSBCLのソースコードも怖くない、と思って読み手が増えることを願って。

詳解SBCL - 世代別GC(3)

昨日はルートのマーキングまで書いたので、今日はいよいよ実際にオブジェクトを動かすところ、つまりSBCLの世代別GCの肝の部分に触れていこう。

【scavenge】
この処理がすべての処理の鍵であるといってもまぁ、過言ではないだろう。とりあえず中身を見ていこう。(src/runtime/gc-common.cより、一部整形及び削除)

void scavenge(lispobj *start, sword_t n_words)
{
    lispobj *end = start + n_words;
    lispobj *object_ptr;
    sword_t n_words_scavenged;

    for (object_ptr = start; object_ptr < end; object_ptr += n_words_scavenged) {

        lispobj object = *object_ptr;

        if (forwarding_pointer_p(object_ptr))
            lose("unexpect forwarding pointer in scavenge: %p, start=%p, n=%l\n",
                 object_ptr, start, n_words);

        if (is_lisp_pointer(object)) {
            if (from_space_p(object)) {
                /* It currently points to old space. Check for a
                 * forwarding pointer. */
                lispobj *ptr = native_pointer(object);
                if (forwarding_pointer_p(ptr)) {
                    /* Yes, there's a forwarding pointer. */
                    *object_ptr = LOW_WORD(forwarding_pointer_value(ptr));
                    n_words_scavenged = 1;
                } else {
                    /* Scavenge that pointer. */
                    n_words_scavenged =
                        (scavtab[widetag_of(object)])(object_ptr, object);
                }
            } else {
                /* It points somewhere other than oldspace. Leave it
                 * alone. */
                n_words_scavenged = 1;
            }
        } else if (fixnump(object)) {
            /* It's a fixnum: really easy.. */
            n_words_scavenged = 1;
        } else {
            /* It's some sort of header object or another. */
            n_words_scavenged =
                (scavtab[widetag_of(object)])(object_ptr, object);
        }
    }
    gc_assert_verbose(object_ptr == end, "Final object pointer %p, start %p, end %p\n",
                      object_ptr, start, end);
}

与えられたstartの中身を順番に見ていき、Lispオブジェクトでかつ既に移動されたものならば移動先に置き換える、まだならscavtabテーブルに格納された実際の処理に処理を委譲する。*object_ptrが何を指すのか今一理解できなくて、SBCLのGCはどう動いているのだろうなんて疑問に思ったのは秘密である(well if you have read my articles or twitter, you know...)。ここで、ポイント(と僕が思う部分)は与えられたstartは必ずヒープ領域を指すことだろう。また、特に何もしなくてもオブジェクトの割り付けられたメモリ境界を指すということだ。これは、scavengeが呼ばれる部分を見れば分かるのだが、事前にページもしくはリージョンの開始位置を計算しているのと、割り付けられたオブジェクトの位置を直接渡していることに起因する。詳しくはsrc/runtime/gencgc.cにあるgarbage_collect_generationを参照されたい(多分後で多少触れるけど)。

ではscavtabには何が入っているのだろうか？

この辺は実は非常に読みやすくて、scav_のプリフィックスがついた関数がsrc/runtime/gc-common.cにある。それらを眺めればどの処理がどのオブジェクトに対応しているのか大体わかるという寸法。実際の振り分けは、widetag_ofが適切にオブジェクトからタグを取り出すのでそれにしたがっている。また、テーブルの設定も同様に行われる。タグが255もあるのでテーブルの設定はすごく長い処理になっているのはまぁご愛嬌だろう(src/runtime/gc-common.cのgc_init_tables参照)。

とりあえず、一つ中身を見てみよう。Lispといえばでリストを見る。

static sword_t scav_list_pointer(lispobj *where, lispobj object)
{
    lispobj first, *first_pointer;

    gc_assert(is_lisp_pointer(object));

    /* Object is a pointer into from space - not FP. */
    first_pointer = (lispobj *) native_pointer(object);

    first = trans_list(object);
    gc_assert(first != object);

    /* Set forwarding pointer */
    set_forwarding_pointer(first_pointer, first);

    gc_assert(is_lisp_pointer(first));
    gc_assert(!from_space_p(first));

    *where = first;
    return 1;
}

処理としては非常に簡単で、与えられたリストobjectをtrans_listでコピー、その後whereが指すポインタと入れ替える。trans_listはリストの指すcarとcdrを単にコピーしているだけで、その中身までは見ない(コード貼り付けると無駄に長くなるので割愛)。これによってリニアタイムの処理になる。

では、リストの中身が指すポインタは一体誰が救うのか？

ここまで読んでいれば勘のいい人は既に分かっているだろうが、scavengeである。実際にscavengeは以下の3つの段階で呼ばれる。

1. 割り込みハンドラ、バインディングスタック及びSBCLの静的領域の回収
2. GC対象外の世代の回収
3. 新しい世代の回収

の3つである。ものすごく簡単に言えば、GC対象のヒープ領域以外のヒープをすべて回収し、GC対象の領域でピン止めされたページ以外はごみとするという感じである。

これで大まかなSBCLのGCの流れは終了。書き忘れたこととかあるかな？

今日はここで時間切れ。Genesisについては明日触れることにする。

Bignumの最適化

事の発端は以下の記事

#:g1: XCLがSBCLより速いところ

最終的に行き着くのはBignumのexptでそいつが遅いことは実は分かっていた(手元のマシンで測ると、Gaucheで20秒ちょっと、Sagittariusでは30秒以上かかっていた)。っで、まぁ、遅いのは気に入らないので何とかならないかと無い知恵と頭をフル回転させることにした。

大抵Bignumが遅い一番の理由はメモリである。で、実装を見てみると豪華に作っては捨てるを繰り返していたのでここを何とかしようと頑張ってみた。ちょっとしたベンチマーク。

(import (time))
(time (begin (expt (* 100000 100000) #x2FFFF) 1))

乗数が半端なくでかい場合という感じのもの。結果(上が0.4.3、下が開発版)。

% sash test.scm

;;  (begin (expt (* 100000 100000) 196607) 1)
;;  147.578838 real    147.4670 user    0.000000 sys

% ./build/sash.exe test.scm

;;  (begin (expt (* 100000 100000) 196607) 1)
;;  28.751352 real    28.68900 user    0.016000 sys

大きく効果があった感じがする(とは言っても5倍か)。ついでにこの記事の元になったベンチマーク結果。

% sash test.scm

;;  (begin (^^ 10 6) 1)
;;  33.010235 real    33.01000 user    0.000000 sys

% ./build/sash.exe test.scm

;;  (begin (^^ 10 6) 1)
;;  4.867294 real    4.867000 user    0.000000 sys

7倍程度の高速化。まぁ、何が悲しいかと言えば、これでもYpsilonに並んだ程度なのと、Mosh(gmp)より50倍程度遅いことか。ま、SBCLに並んだということで満足してしまおう・・・

詳解SBCL - 世代別GC(2)

今日はいよいよメモリの割付とGCについて。朝の暇な時間を使っているのでGCは最後まで書けないかも。

【メモリ割付】
SBCLではメモリの割付はリージョンを通して行うというのは昨日書いた。それをすると何がうれしいかという話である。
たとえばBoehm GCではメモリは要求サイズをフリーリストから取ってくる。もちろん実際にはもっと最適化されていて、(記憶が正しかったら)8、16、24、といった感じでよく使われる小さいオブジェクトと大きいオブジェクトで別に管理している。っで、8バイトなら8バイト領域のフリーリストから取ってくるのでメモリがフィットするかどうかを調べる必要がないといった感じ(だったはず)。
では、SBCLではどうか？多くのコピーGCと同じくメモリの割付は先頭メモリのポインタを返すだけである。なので(おそらく)高速に動く。もちろん、ページ単位でメモリの割付を行うのでリージョンが管理しているアドレスの末尾を超えるようなサイズのチェック等はある。
実際に割付のコードを見てみよう。 (src/runtime/gencgc.cより、一部整形及び削除)

static inline lispobj *
general_alloc_internal(sword_t nbytes, int page_type_flag, struct alloc_region *region,
                       struct thread *thread)
{
    void *new_obj;
    void *new_free_pointer;
    os_vm_size_t trigger_bytes = 0;

    if (nbytes > large_allocation)
        large_allocation = nbytes;

    /* maybe we can do this quickly ... */
    new_free_pointer = region->free_pointer + nbytes;
    if (new_free_pointer <= region->end_addr) {
        new_obj = (void*)(region->free_pointer);
        region->free_pointer = new_free_pointer;
        return(new_obj);        /* yup */
    }
              :
    /* 削除 (GC起動用コード)*/
              :
    new_obj = gc_alloc_with_region(nbytes, page_type_flag, region, 0);

    return (new_obj);
}


/* Allocate bytes.  All the rest of the special-purpose allocation
 * functions will eventually call this  */
void *
gc_alloc_with_region(sword_t nbytes,int page_type_flag, struct alloc_region *my_region,
                     int quick_p)
{
    void *new_free_pointer;

    if (nbytes>=large_object_size)
        return gc_alloc_large(nbytes, page_type_flag, my_region);

    /* Check whether there is room in the current alloc region. */
    new_free_pointer = my_region->free_pointer + nbytes;

    if (new_free_pointer <= my_region->end_addr) {
        /* If so then allocate from the current alloc region. */
        void *new_obj = my_region->free_pointer;
        my_region->free_pointer = new_free_pointer;

        /* Unless a `quick' alloc was requested, check whether the
           alloc region is almost empty. */
        if (!quick_p &&
            void_diff(my_region->end_addr,my_region->free_pointer) <= 32) {
            /* If so, finished with the current region. */
            gc_alloc_update_page_tables(page_type_flag, my_region);
            /* Set up a new region. */
            gc_alloc_new_region(32 /*bytes*/, page_type_flag, my_region);
        }

        return((void *)new_obj);
    }

    /* Else not enough free space in the current region: retry with a
     * new region. */
    gc_alloc_update_page_tables(page_type_flag, my_region);
    gc_alloc_new_region(nbytes, page_type_flag, my_region);
    return gc_alloc_with_region(nbytes, page_type_flag, my_region,0);
}

前提条件として要求サイズは8の倍数(src/runtime/alloc.cで切り上げられる)である必要がある。gc_alloc_internalを見ると分かるが、要求されたサイズが末尾アドレスを超えない場合は先頭アドレスを返し、末尾アドレスを増やす。超える場合は新たにリージョンの割付を行い、やはり先頭アドレスを返す(gc_alloc_with_region)。
Boehm GCと違いSBCLではヒープから割り付けられるオブジェクトはLispオブジェクトのみと割り切っている(はずな)ので、メモリはヘッダ情報等を持つことはない。 逆に、consを除く全てのオブジェクトはヘッダ情報を持っていて、そこからオブジェクトのサイズ等を割り出すことが可能である(はず、自信ない・・・)。
まぁ、メモリの割付なんてそう面白いところはないので、適当に切り上げて次へ(逃走ともいう)。

【GC】
さて、ようやく本題のGCである。SBCLではGCの起動方法は2種類あって、ユーザーが直接Lisp手続きのgcを叩くのと、リージョンの使用メモリがトリガーバイト以上になった際に勝手に起動されるのの2種類である。(前者しか用意されてなかったらGCじゃないわね・・・)

では、GC起動の大まかな流れを見てみよう。流れとしては以下のようなフローになる。

1. メモリ割付時に*gc-pending*フラグにtをセットする
2. ついで擬似アトミックに割り込みフラグをセットする
3. 割付終了後、擬似アトミックの割り込みをチェック
4. 割り込みがあれば割り込みを処理させる
• 割り込みはCPU割り込みで実現される(int3もしくはud3命令)
5. 使ってないスタックをきれいにする
6. 世界を止める
• SBCLではincrementalマーキングとか、mostly concurrent GCとか軟弱なものはなく、漢らしくGCの間世界には止まってもらう
7. ごみ集めする
• 基本的には第一世代のみを行うが、必要(次の世代もメモリが足りない)ならば以降の世代も行う
• 明示的にどの世代をGCするかの指定も可能
8. *gc-pending*にnilをセットする
9. 世界を動かす
10. ファイナライザを起動させる

ファイナライザはGC終了後に起動されるのは(多分)Boehm GCでも同じだと思う。(ファイナライザがメモリを要求したらとか考えるとそうあった方が便利な気がするし。)
SBCLのファイナライザはLisp側で実装されていて、起動時にはGCが起きないようになっている(src/code/final.lisp参照)。

世界を止めるのはマルチスレッドでは重要だけど、今回はシングルスレッドの流れを追っているので深くは言及しないが、pthread_killでUSR2(内部でGC用シグナルとして定義)を送りスレッドを止めている。開始はその逆。わざわざシグナルを使っているのは、標準POSIXのpthreadではサスペンドがサポートされていないことと、Linuxのpthreadには拡張としてのpthread_suspend_npに対応するものがないことだと思われる。(Windows、*BSDとかだとスレッドのサスペンドが可能)。

【ルートマーキング】
SBCLにおいてGCルートと考えられているのは2つ、スタックとレジスタである。 マーキングは非常にシンプルで、スタックの底から現在のスタックポインタまでにあるヒープ領域に取られたLispオブジェクトもしくはコード(マシンコード)っぽいものを保存する。レジスタ上でも一緒。スタックの底はpthread_attr_getstackで取得(Windows除く)。

実際に何をするかと言えば、ルート上にあるそれっぽいオブジェクトが所属するページ丸ごとピン止めするのである。ページは最低でも4096バイトあるので、ある意味漢らしい。まぁ、いろいろ考えるよりは楽だわね。(詳細はsrc/runtime/gencgc.cにあるpreserve_pointerを参照)

 タイムオーバーなので今日はこのくらいで。続きはまた明日。

詳解SBCL - 世代別GC(1)

全てのSBCLソースリーディングをしている人の手助けになることを願って。

そろそろ詰め込んだものがページアウトしそうなのでちょっと外部記憶に書き出しておこう。タイトル的には仰々しいことを書くような煽りだが、実際はそうでもないのでかなり釣りです。また、誤りが含まれている可能性が多分にあるので見つけたら指摘していただけるとうれしいです。

(1)となっているのは次がある予定だから。というか、全てを一つの記事するのはきついので。

以下の記事は世代別GCとは何ぞやということが分かっている人が対象になります。また、話を可能な限り簡略にするため、環境はX86、POSIX、シングルスレッド環境とします。言及しているSBCLのソースはバージョン1.1.5のものです(2013年3月20日現在の最新)。

【概要】
SBCLではメモリの管理は、リージョン、エリア、世代、ページの4つのグループを使って行われる。簡単なイメージは以下のような感じ。

                 mutator
                    |
                 gc_alloc
                    |
+-------------------------------------------+
|                region                     |
+-------+------+----------------------------+     +---------------------------+
|  page | page | ...                        |  -- |         * area            |
+-------+------+--------------+-------------+     +---------------------------+
| generation 0 | generation 1 | ...         |
+--------------+--------------+-------------+

* エリアはGCの際にのみ使われます。

メモリは割付は必ずリージョンを通して行われ、リージョンはページの開始アドレス、現在のフリーなアドレスを保持します。
ページは使用されているバイト、リージョンからのオフセット、所属している世代、その他もろもろの情報を保持します。リージョンからのオフセットは結構重要で、ページのアドレスから実際のリージョンの開始アドレスを割り出せます。
世代は所属しているページの最初のアドレス、その他GC回数等の情報を保持します。

恐らくここまでは他の世代別GCとは大きく変わらないと思います。

実際のメモリ割付及びGCに入る前に登場人物の説明。

【ページテーブル】
SBCLでは全てのページはページテーブルで管理されます。ページテーブルはページの配列で、その個数はヒープサイズから割り出されます。実際のコードは以下の通り(src/runtime/gencgc.cのgc_initより)

    /* Compute the number of pages needed for the dynamic space.
     * Dynamic space size should be aligned on page size. */
    page_table_pages = dynamic_space_size/GENCGC_CARD_BYTES;

                           :

    /* The page_table must be allocated using "calloc" to initialize
     * the page structures correctly. There used to be a separate
     * initialization loop (now commented out; see below) but that was
     * unnecessary and did hurt startup time. */
    page_table = calloc(page_table_pages, sizeof(struct page));

GENCGC_CARD_BYTESはビルド時にgenesis(多分2以降の記事で書く)で定義される値。ちなみにX86環境では4096。
dynamic_space_sizeは大域変数でSBCL起動時にヒープ指定用。デフォルトはsrc/runtime/gc-common.cで以下のように定義:

os_vm_size_t dynamic_space_size = DEFAULT_DYNAMIC_SPACE_SIZE;

ちなみに、DEFAULT_DYNAMIC_SPACE_SIZEの定義はsrc/runtime/validate.hにあり、以下の通り：

#ifdef LISP_FEATURE_GENCGC
#define DEFAULT_DYNAMIC_SPACE_SIZE (DYNAMIC_SPACE_END - DYNAMIC_SPACE_START)
#else
#define DEFAULT_DYNAMIC_SPACE_SIZE (DYNAMIC_0_SPACE_END - DYNAMIC_0_SPACE_START)
#endif

この記事では世代別GCを扱っているので、LISP_FEATURE_GENCGCは定義されている。DYNAMIC_SPACE_ENDとDYNAMIC_SPACE_STARTはgenesisでビルド時に割り出される固定アドレスである。

話が逸れたので、ページテーブルに戻す。 ページテーブルはSBCLが管理するヒープ外で管理されており、具体的にはcallocで割り付けられたメモリ、当然だがGCの対象にならない。ページ、ページテーブルは実際のヒープを指すわけではなく、そのメタ情報を扱っている。実際にあるページが指すヒープは以下のように割り出される(src/runtime/gencgc.c
より)：

/* Calculate the start address for the given page number. */
inline void *
page_address(page_index_t page_num)
{
    return (heap_base + (page_num * GENCGC_CARD_BYTES));
}

heap_baseはDYNAMIC_SPACE_STARTと同値である(gc_initで設定されている)。1つのページはGENCGC_CARD_BYTESで区切られるのでこのように計算できる。

【リージョン】
シングルスレッド環境ではリージョンはたったの2つ、boxed_regionとunboxed_regionである。基本的な違いは、前者は割り付けられたメモリ内にポインタを持ち、後者は持たないというだけのもの。たとえば、CLのconsは前者のリージョンから、basic_stringは後者のリージョンから割り付けられる。

リージョンは実際のヒープアドレスを持ち、メモリの割付を行う。

【世代】
SBCLでは6つの世代＋スクラッチ用世代の7つの世代が用意されている。スクラッチ用世代はGCの際にコピー用のヒープを保持する世代で、GC対象の世代がプロモートしない場合に使用される。
他の世代別GCと同様にある一定回数のGCが行われかつ生き残ったオブジェクトは次の世代にプロモートされる。ちなみに、デフォルトでのプロモートGC回数は1回。つまり、2回生き残ると次の世代に昇格する。このパラメータはLISP側から世代毎に調整できる(src/code/gc.lisp参照)。

疲れたので今日のところはここまで。明日辺りにメモリの割付以降の話を書く。

脱BoehmGCへの道 実装編(2)

昨晩BBCのコミックリリーフを見ながら(寝ながら)実装方針のようなものを考えていた。

とりあえず、SBCLがどのようにポインタ内のポインタを解決しているのかは考えないようにして(たぶんscavengeがその辺をうまいこと扱っているんだと思うけど)、まずは動くものを作ろうという感じである。

とりあえず現状での違いを列挙
【SBCL】

• 保存するポインタは、スタック及びレジスタのみ
• 静的領域は持ってない
• 動的にコードを生成するのだからある意味当たり前ではある
• 全てのポインタは中身にアクセスすることなくおよそLispオブジェクトかの判別が可能
• これによって実際にscavenge及びtransportを行う手続きをテーブルで持つことが可能
• 全てのポインタからおよその割付サイズを割り出すことが可能

【Sagittarius】

• 保存するポインタは、スタック、レジスタ及び静的領域
• 結構な勢いでstaticなオブジェクトを持っているので変更したくない
• Schemeオブジェクトかどうかの判別にはポインタの中身を見る必要がある
• 単なるコンテナのpairはどうしても一般的なメモリとしてしか判別できない
•  動的領域から割り付けられたものならばメモリヘッダからサイズの割り出しが可能
• あいまいなポインタがきた場合に多少困る
• 一応チェックが走るけど、不安

 今更ながらにオブジェクトをタグにしておけばよかったと多少後悔しているが、まぁ泣くまい。

っで、実装戦略(というほどでもないが)だけど、現状で困っているのはポインタ内ポインタの保存である。とりあえず、スタック及びレジスタ上で参照されているポインタを動かすのは嬉しくないのでこいつは無視して(不可能ではないが)、静的領域である。
いったん保存されたアドレスはページ単位で移動を禁止される、なので保存先のアドレスから中身をたどっていき全てのオブジェクトを新たな世代(もしくは単にページ)に移動させる。この際に既に保存されているものであれば動かしてはいけないのでそのままにする必要がある。そうすると、たどれるポインタのうち、スタック、静的領域及びレジスタ上にないものは全て昇格することになり、世代別GC的に動く(ような気がする)。
ここで気になるのは、スタック上で保存されたポインタで、こいつからたどれるものはどうしようかなぁというところである。まぁ、静的領域と同様にやってしまってもいいような気はするのだが、そうするとまだ保存されていないポインタを動かすことになるような気がしている。あぁ、でも動いた先をいれてやれば問題ないのか？あんまりアグレッシブに動かすと1が10になる問題が起きるよなぁ。

とりあえずこの方針で行くことにする。

脱BoehmGCへの道 準備編(4)

実装編書いたのに準備編に逆戻りｗ

コードリーディングに関するのは準備編にまとめようと思っているだけなので実装をしていないわけではないんだけど、妙な感じではある。

SBCLのコードを読んでてどうも納得がいかないというか、理解ができていない部分がある。オブジェクトのコピーである。他のGCと同様SBCLも世代別GCも最初にスタックエリア、静的エリア(SBCLが内部で持ってるもので、.dataとかではない)におかれているポインタの保存をした後にごみ集め(scavenge)するようになっている。

まぁ、これだけ見れば特に問題ないように見えるんだけど、世代別GCではコピーが発生する。コードを読んでいるとscavenge_newspace_generationがコピーを行うとコメントに書いてあるのだが、 最終的にそいつはscavengeにたどり着き普通に回収しているように見える。また、ポインタを保存する際にそのオブジェクトが保持している中身には一切の興味を示していない。つまり、ルートからたどれる最初のオブジェクトしか保存していないようにみえるのだ。(実際は、ページ丸ごと保存しているので4096バイト(32ビット？)ごそっと保存してるんだけど。)

これはLisp側のコードも解析しないといけないかなぁと思い、ちょっと眺めてみた。知っている人は知っていると思うけど、SBCLはVOPと呼ばれる仮想アセンブリ言語があってこいつが非常に読みづらい。頑張ってたどっていくと、X86環境ではメモリの割付はallocation手続きからalloc_overflow_*(ecxとかとか)が呼ばれ最終的にCで定義されたallocそして、世代別GCならgeneral_allocが呼ばれることが分かった。ということは、Lisp側で割り付けられようが、CのAPI使おうが(SBCLは外部にAPIを公開してないので不可能だけど)、最終的には同じメモリが同じように割り付けられているはずである。

となってくると、たとえばベクタなんかが中にLispオブジェクトを保持していた場合どうにかしてコピーしないとまずいことになると思うんだけど、どうなってるんだ？確かに、scav_other_pointerではオブジェクトの最初のアドレスからヘッダをとってコピーしてるんだけど、こうあるべきなのか？

そもそも、general_allocを勘違いしている可能性があるといえばあるんだけど・・・

Sagittarius 0.4.3 リリース

Sagittarius Scheme 0.4.3がリリースされました。今回のリリースはメンテナンスリリースです。
ダウンロード

【修正された不具合】

• evalがunbound variable errorを投げる不具合が修正されました
• 閉じられたソケットに対してsocket-sendを呼ぶとSIGPIPEで落ちる不具合が修正されました
• キャッシュファイルをロードする際にライブラリのインポート順序が逆順になっている不具合が修正されました
• bytevector->stringがSIGILLを起こす不具合が修正されました
• R7RSのloadにenvironment引数を渡すとカスタムリーダが認識されない不具合が修正されました

【改善された点】

• メモリの使用量が多少少なくなりました

【新たに追加されたライブラリ】

• リモートREPLライブラリ(sagittarius remote-repl)が追加されました

【新たに追加された機能】

• (rfc tls)がサーバソケットとTLS 1.2をサポートするようになりました
• (rfc x509)ライブラリに基本的な証明書を作成するための手続きが追加されました
• (rfc x509)に証明書をバイトベクタに変換する手続きが追加されました

脱BoehmGCへの道 実装編(1)

SBCLの保守的世代別GCを参考(*1)に自前GCをちょぼちょぼ実装している。メモリの割付はいけるがGCがうまいこと動いていないのですぐにSEGVる。

とりあえず現状ぶつかっている妙な挙動と実装上のメモ

【実装上のメモ】

• SBCLではヒープに割り付けられたメモリは*ほぼ*Lispオブジェクトとして扱える
• 一部違うものもあるっぽいが、少なくとも2ワードはあると断定できるらしい
• Lispオブジェクトならヘッダーが第一ワードにきて、そいつからサイズも特定できるっぽい
• さすがにこれは真似できない
• ↑をなんとかするためにメモリブロック＋ヘッダという構造を導入
• サイズとフォーワードチェック用の構造体
• フォーワードチェック用に1ビット、残りはファイナライザを詰める
• アライメントの関係上2ワード取るようにする
• 32ビットなら8バイトの無駄
• でも、ファイナライザもいれないといけないしということで妥協
• スタックの底は頑張ってOSコールで取るようにした
• データセグメントは_data_startとかで頑張る
• Windowsはどうしようかね？
• 前に書いたハックで頑張るか
• Cygwin上のmmapについて
• MAP_NORESERVEを指定しないようにした
• 512MB必要としているので、Cygwinのメモリだとスワップ領域を確保しないときついはず、ということで

【妙な挙動】
主な開発環境はCygwinなので、とりあえずの妙な挙動はCygwinということになる。っで、妙な挙動。

静的領域を取るためにCygwinでは_data_start__系の値を使うのだが、GDB上で見ると正しく取れているように見えるんだけど、実際には意味不明な値が飛んできている。 たとえば、GDB上では開始アドレスは0x6a5a4000となっているんだけど、実際には0x3000とどう見てもアドレスに見えない値が取れている。

追記：
多分メモリ破壊的な何かが起きてる感じである。最初のGCではOKなのに2回目で死んでる。

追記の追記：
単にアホなミスであった。まず自分から疑うべきである・・・

*1 参考＝コピペとも言う。コピペプログラマは適当にアジャストするのも得意なのであるw

脱BoehmGCへの道 与太話

SBCLのコードを読んでいると、コンパイラとかデバッガを作るということがいかに環境べったりのコードを書く必要があるかということを実感させられる。もちろん、それを#ifdefで区切るのか、もっと抽象化してやるのかは実装者の好みだろう。

コード読んでて感動したのが以下のコメント。

    /* On entry %eip points just after the INT3 byte and aims at the
     * 'kind' value (eg trap_Cerror). For error-trap and Cerror-trap a
     * number of bytes will follow, the first is the length of the byte
     * arguments to follow. */
    trap = *(unsigned char *)(*os_context_pc_addr(context));

これは、Windowsなら、handle_breakpoint_trap、x86環境ならsigtrap_handlerにあるコードなんだけど、どうやってその'kind'を飛ばしているかというと以下のアセンブラから飛んでくる。

 .globl GNAME(do_pending_interrupt)
 TYPE(GNAME(do_pending_interrupt))
 .align align_16byte,0x90
GNAME(do_pending_interrupt):
 TRAP
 .byte  trap_PendingInterrupt
 ret
 SIZE(GNAME(do_pending_interrupt))

別にdo_pending_interruptである必要はないけど、ようするにこんな感じで飛ばすのである。んで、C側ではEIP(x86)の次のバイトを読む。SIGTRAP飛ばすのにint3もしくはud2使ってる。ud2だとSIGILLか。

最初なんでOSのPCなんて必要なんだろうと思ったけど、こういう理由でいるみたい。「完全解説SBCL」なんて本が出たら多分買うと思う。

脱BoehmGCへの道 準備編(3)

実際のコードの準備に入る。

Twitterでも呟いたのだが、SBCLは*_SPACE_(START|END)という奇妙な固定アドレスがあって、これらは環境(OS、アーキテクチャ)によって値が違う。Genesisというビルド時に走るソース生成のLispがこいつらを作るのだけど、この値を使ったら負けな気がしてるのと、ポータビリティが下がるどころの話じゃないのでなんとかデータセグメントをランタイムで取れないかを探っている。(ここまで前置き)

Linuxとか*BSD環境だと、etextとかedataとか使えるのだけど(GCC?)、Windowsだとそうは問屋がおろしてくれない。Boehm GCはこの辺をMEMORY_BASIC_INFORMATIONと多少のハックで何とかしているのだが、.dataセグメントをとるのなら以下の方法でもいけることが分かった。

/* dll.c */
#include <windows.h>
#include <winnt.h>
#include <dbghelp.h>
#include <stdio.h>

__declspec(dllexport) void dump(HANDLE hModule)
{
  char *dllImageBase = (char*)hModule;
  IMAGE_NT_HEADERS *pNtHdr = ImageNtHeader(hModule);
  IMAGE_SECTION_HEADER *pSectionHdr = (IMAGE_SECTION_HEADER *) (pNtHdr + 1);
  int i;
  printf("base   : 0x%p\n", dllImageBase);
  for (i = 0 ; i < pNtHdr->FileHeader.NumberOfSections ; i++) {
    char *name = (char*) pSectionHdr->Name;
    printf("name   : %s\n", name);
    printf("section: 0x%p\n", dllImageBase + pSectionHdr->VirtualAddress);
    printf("size   : %d\n", pSectionHdr->Misc.VirtualSize);
    pSectionHdr++;
  }
}

__declspec(dllexport) int show()
{
  HANDLE hModule = GetModuleHandle("dll.dll");
  dump(hModule);
  return 0;
}

/* linked.c */
#include <windows.h>
#include <winnt.h>
#include <dbghelp.h>
#include <stdio.h>

__declspec(dllimport) int show();

int main()
{
  HANDLE hModule = GetModuleHandle(NULL);
  char *dllImageBase = (char*)hModule;
  IMAGE_NT_HEADERS *pNtHdr = ImageNtHeader(hModule);
  IMAGE_SECTION_HEADER *pSectionHdr = (IMAGE_SECTION_HEADER *) (pNtHdr + 1);
  int i;
  printf("base   : 0x%p\n", dllImageBase);
  for (i = 0 ; i < pNtHdr->FileHeader.NumberOfSections ; i++) {
    char *name = (char*) pSectionHdr->Name;
    printf("name   : %s\n", name);
    printf("section: 0x%p\n", dllImageBase + pSectionHdr->VirtualAddress);
    printf("size   : %d\n", pSectionHdr->Misc.VirtualSize);
    pSectionHdr++;
  }

  printf("should be in DLL\n\n");
  show();

  return 0;
}

/* load.c */
#include <windows.h>
#include <stdio.h>

typedef void (*Dump)(HANDLE);

int main()
{
  HMODULE handle = LoadLibrary("dll.dll");
  Dump dump;

  dump = (Dump)GetProcAddress(handle, TEXT("dump"));
  if (dump) {
    dump(handle);
  } else {
    printf("something wrong\n");
  }
  return 0;
}

問題なのはLoadLibraryではなくリンクされた方だったりする。GetModuleHandleは.exeのハンドルを取得するらしく、DLLの名前を渡さないと.exeと同じアドレスになった。おそらくDllMainでDLLがアタッチされた際に引数として渡されるハンドルを保存しておくのがいいだろう。LoadLibraryの方は逆にハンドルが返されるので、既存の拡張DLLのコードをいじることなくいけそうである。

唯一これが問題だなぁと思うのは、dbghelp.libをリンクする必要があることだろうか。おそらくXP以上の環境ならMSVCライブラリを入れなくてもあると思うんだけど、ちょっと不安。

ふとBoehm GCのこの辺のハックを読んだときに思ったのだが、Boehm GCってDLLを呼ぶたびにGC_INIT呼ばないとまずいのかな？それともLoadLibraryをフックしてる？じゃないとDLLごとの静的領域がルートに入らない気がするのだけど・・・

脱BoehmGCへの道 準備編(2)

Scheme48の世代別GCを読むと言ったな、あれは嘘だ・・・orz

引き続きSBCLの世代別GC。さすがにこの規模のコードを2,3時間でっていうのは無理があって、読んでるうちにいろいろ発見がある。

GC自体はcode/gc.lispで定義してあって、こいつが世界を止めてごみ集めしてまた世界を動かしてる。これは誰が読んでるんだ？メモリ割付はGCが必要かどうかのフラグをセットしてるだけだし。
以下はメモ：

• Windows以外の環境ではsignal (SIG_STOP_FOR_GC: SIGUSR2)を使って世界を止めてる
• Windowsではそんなシグナルないので、safepointと呼ばれるものでごにょごにょしてる
• 多分CreateEventで何とかなるか？
• 世界を止めるために作られたスレッドを全て管理している
• そんで、pthread_killでSIG_STOP_FOR_GCを送りスレッドを止める
• なんで現在のスレッド以外を再び起こしてるんだろう？
• そして起こせたらエラーで死んでる・・・
• 単なる再チェック？
• シグナルを送らないとGCが発生しないように見えるけど、シグナル送るのはstop the worldという矛盾
• interrupt_handle_pendingのコメントに書いてあった
• allocが*gc-pending*にtを入れる
• set_pseudo_atomic_interruptedが呼ばれる
• do_pending_interruptが呼ばれる(アセンブラなんだぜこれ・・・)
• int3もしくはud2命令でSIGTRAPを送る
• 後ろにtrap_PendingInterruptをつけて識別する
• handle_trapが起動される
• ようやくinterrupt_handle_pendingにたどり着く・・・

なんでここまでしてシグナルを使いたいのかは不明。いろんな兼ね合いがあるのだろう。(シグナルを送るとスレッドのことを考えなくてもいいとか？GCの起動をぎりぎりまで遅らせたいとか？)

なんとなくばらばらなピースが合わさってきた感じがする。

脱BoehmGCへの道 準備編(1)

2があるかは知らない。(たぶんある、Scheme48で)

SBCLは2種類のGCをサポートしていて、(たぶん)デフォルトでは保守的世代別GCが使われている。しかも、ランタイムの部分はCで書かれているといるので、これは読まなければならないだろうと思って読んだ(理解は微妙・・・)。

世代別GCがなんぞやという人はここが詳しい：GCアルゴリズム詳細解説

GCを実装する上で(個人的に)重要な点は、割付とGC部分の2箇所。メモリに対してどんなメタ情報を付与するのかと、どのようにルートをたどるのかという部分。この辺はGCレベル(何それ？)が高い人は違うのかもしれないが、レベル1以下の僕にはそう見える。

SBCLはメモリの割付をリージョンと呼ばれるヒープから割り付ける(スモールオブジェクト)。っで、こいつはページテーブル内で管理されていて、必要に応じて拡張されたりしている。(まじめに追ってない・・・)。

GCは保守的になる必要がある場合のみに保守的に行われる。具体的にはX86、X86_64な環境。ただし、それらの環境でもgc_and_saveで呼び出された場合はPreciseで行われる。(たぶんコアイメージの保存用？)。
保守的なGCは外部C呼び出し(Foreign C call)の際にのみ起きる(とコメントにある)ので、スレッドコンテキストからその辺りのPCを持ってきてポインタらしきものをマークしている。マークが終わると回収なのだが、回収はX86、X86_64以外の環境ではスタックを問答無用で回収する。どういう仕組みでX86、X86_64以外の環境がPrecise GCになるのかは(今のところ)不明。(FFIが無いとか言うシンプルな理由かもしれない)。回収自体はポインタサイズ(種類？)で回収の仕組みが違う。それぞれに適した回収と移動が実装されている。(うへぇ・・・)

読んでて気になったというか、やっぱりなぁと思ったのは、保守的GCという性質上どうしてもOS、アーキテクチャ依存の部分が出ざるを得ないということ。SBCLはその辺がかなりうまく分離されているので対象のコードを読むこと自体はあまり苦ではないのだが、自前でGCを持つということはBoehmGCが行っているハックを大なり小なりやる必要があるということが分かってちょっとがっかり。
後、SBCLはビルド時にホストとターゲットをビルドするのだけど、ホストがランタイムの設定及びヘッダファイル郡(genesis)を生成する。もっとも気になるのはthread.hでこいつはGCのコードでもスレッドコンテキスト等を取得する際に多用されている。これがビルド時に生成されるということは、ターゲットの環境によって中身が大きく変わる可能性があるということ(構造体のオフセットまで全部生成されてるし)。

規模が規模だけに全部を把握するのは難しいが、参考になる部分はたぶんにありそう。

脱BoehmGCへの道 計画編

別にBoehmGCに対してそこまで不満があるわけではないのだけど、Sagittariusは既にインストールされているライブラリ(Unix系環境)もしくは新規にダウンロードして特に手を入れることなく使う(Windows環境)という手法をとっているので、サポートしていない環境で動かすのに支障がでる。(たとえばFreeBSDの最新のportsでは不具合があってSEGVる)

それ以外だとGaucheやMoshみたいにGC_sizeから割り付けられたサイズを求めてごにょごにょするといいったことができないとか、多少の不満があったりはする。

そこでとりあえずなんとかならないだろうかと思い計画＋どうしようこれ？的な問題点を思いつくままにずらずらと。

計画(妄想)的な何か

• 世代別GCにしたい
• 特に理由はないけど、大域定義とかはGCされる率は極めて低いので効果的な気がする
• Scheme48の最新版は世代別GCを実装してるし
• パラメータでGCの挙動をチューニングできるようにしたい
• メモリ割付を安価にしたい
• Ypsilonはメモリの割付がおそらくすごく高速(ctak見て思ったこと)
• BoehmGCはベンチ取ったことないから知らないけど・・・

問題的な何か

• Conservative GCかPrecise GCか
• 世代別ならPreciseじゃないとまずいのか？
• 現状のコードを書き直さないようにしたい
• Conservativeな世代別GC？(可能なの？)
• マルチスレッド環境をどうするか
• ヒープの場所をどうするか
• スレッド毎に持つ
• 子スレッドが死んだ時にどうする？
• ヒープはメインスレッドのみが持つ
• 割付ごとにロックする
• 遅くね？
• スタックの底をどうするか
• あんまりスレッドモデル依存にしたくない
• かといってアーキテキチャ依存もなぁ(espとかrspとか？)

たとえばYpsilonは自前GC(コピーもしくはコンパクションはしなかったはずだからマーク&スイープかな)だが、ヒープはVM毎に持っていて子は親を参照できるけど書き換えられないとかあったはず。http://d.hatena.ne.jp/fujita-y/20081121/1227252054

RacketはPrecise GCなんだけど、↓なので参考にならない・・・

RacketのPrecise GCをうまいこと移植できないかなぁと眺めていたが、なんでBoehmGCが梱包されているのかの理由とまず不可能だということだけが分かった。Boehm版でソースコードの変換してからPrecise版作ってるんだ。
— Keiさん (@tk_riple) 2013年2月27日

Scheme48の実装を理解しつつ分散GC的な何かを理解するという地道な方法しかないだろうか。できれば、サクッと作って「GCは自前じゃないとね」とか軽口を叩いてみたいのだが・・・

誰かこの本を献本してくだしぁ(ぉぃ

リモートREPLとTLS

別に今のところ使う必要がないのだけど、あると便利かなと思ってリモートREPLを作ってみた。最初はYpsilonのtrunkにあったような簡単なのにしてたんだけど、そうするとreadがエラー投げまくりだったので、もう少しまともなプロトコルを使うようにした。以下のような感じで使える。

;; server side
(import (sagittarius remote-repl))
(define auth (make-username&password-authenticate "test" "test"))
(define server (make-remote-repl "5000" :authenticate auth))
(server)

;; client side
(import (sagittarius remote-repl))
(connect-remote-repl "localhost" "5000")

リモートでいろいろやれるようになるとそのうち便利なことがあるだろうけど、当然問題もでてくる。認証とセキュリティの問題がまずあがるだろう。認証はコードを見ればなんとなく分かると思うけど、ユーザ名とパスワードの認証が実装してある。:authenticateキーワードを省略すると認証なしになる。

さて、セキュリティの問題だが、通信を覗かれるとこのままでは丸見えである。そこで今まで割りと放置気味だったTLSのサーバーソケットを急いで実装した。使い方は以下のようになる。

(import (rnrs) (rfc tls) (rfx x.509))
(define certificate (call-with-input-file make-x509-certificate :transcoder #f))
(define server-socket (make-server-tls-socket "5000" (list certificate))
;; (rfc tls) exports server-accept method so that
;; user can use it for both usual socket and TLS socket.
(let ((socket (server-accept server-socket)))
  ;; so is call-with-socket
  (call-with-socket socket
    (lambda (socket)
      ;; do whatever
     )))

クライアント側がDHEなプロトコルを実装しているなら秘密鍵は要らない。DHE以外のCipher specも使いたいなら秘密鍵を:private-keyで渡してやる必要がある。

TLSの実装はかなりと汚いのでソースを見たい人は覚悟してほしい。そのうちリファクタリングとかまじめにステートを追うようにする予定(今はクライアント、もしくはサーバーが正しい順序でパケットを送ると仮定している)。

この辺まで作ってといざリモートREPLをTLSでと思ったときに証明書がないことに気づいた。(手元にあるときはそれを適当に使っていた)。なので(rfc x.509)ライブラリに簡単なX509証明書生成手続きを足そうかと考え中。鍵対生成は既にあるので。

メモリ使用量

Sagittariusはかなりのメモリ喰いである。割と富豪的にメモリを使用するように書いてあるのでしょうがないのだが、テストを走らせるとメモリ不足で落ちることがしばしばある。実際の用途でこんなにメモリを大量に使うプログラムをまだ書いたことがないので、問題になるのかどうかも分からないのだが、精神衛生上よろしくないということで多少何とかしようと重い腰を上げたところである。

とりあえず分かっているところから潰していくべきだろうと思い、ライブラリのルックアップ用に確保してある部分を削ってみることにした。現状ではSagittariusはインポート時に全てのリネーム、プリフィックス等を解決して、それらをライブラリのバッファに確保している。その方が楽だったのと、たぶん高速だと思ったからである。っが、このバッファたとえば(rnrs)をインポートすると、リネームしてもしなくても全てのシンボルがalistとして保管されるという極めて燃費の悪い仕様になっている。

そこで、特に何も指定せずにインポートした際はバッファを作らないように変更してみて、どれくらいメモリ使用量が減るかを検証してみた。(まだ全部は動いてない・・・)
以下が(import (rnrs)) だけ書いたスクリプトを流した結果。

$ ./build/sash.exe -s -c test.scm

;; Statistics (*: main thread only):
;;  GC: 5591040bytes heap, 11359562bytes allocated, 8 gc occurred

$ sash -s -c test.scm

;; Statistics (*: main thread only):
;;  GC: 5591040bytes heap, 10980426bytes allocated, 8 gc occurred

$ ./build/sash.exe -s test.scm

;; Statistics (*: main thread only):
;;  GC: 4190208bytes heap, 6942600bytes allocated, 7 gc occurred

$ sash -s test.scm

;; Statistics (*: main thread only):
;;  GC: 5591040bytes heap, 7885440bytes allocated, 6 gc occurred

交互にキャッシュなし、キャッシュありで試している。キャッシュなしの場合はキャッシュを作成する必要があるのとかがあいまってあまり違いはない(むしろ変更後の方が多少悪い)。しかし、キャッシュがある場合を見ると、GC回数は増えているがヒープ、アロケートともに1MB程度減っている。

もちろん、今まで使っていた部分を削ったのだから減るのは当たり前なのだが、効果としてはそこまで大きくないような感じがする。ちなみに、(rnrs)をインポートすると20以上のライブラリがインポートされる。つまり、20以上のライブラリからバッファを削ったところで1MB程度しか抑えられないということだ。テストはおそらく合計で200以上のライブラリを作成することになるので、単純計算では10MB以上は消費量が抑えられる計算になるが、どうしたものだろうか。実行速度にどれくらいの影響があるかも見てからかな。

Sagittarius Scheme 0.4.2リリース

Sagittarius Scheme 0.4.2がリリースされました。今回のリリースはメンテナンスリリースです。また、R6RS準拠度が上がっています。
ダウンロード

修正された不具合

• エクスポートされたシンボルが特定の場合に不可視になる不具合が修正されました。
• マクロ展開器がライブラリのスコープを壊す不具合が修正されました。
• datum->syntaxが未束縛のシンボルに対して動作しない不具合が修正されました。
• syntax-case内で局所マクロを定義するとコンパイル時エラーが発生する不具合が修正されました。
• コンパイルキャッシュがSEGVを起こす不具合が修正されました。
• environment手続きが0個の引数を受け付けない不具合が修正されました。
• integer->bytevector手続きにオプション引数を与えた際に非正確な値が返る場合がある不具合が修正されました。
• プリフィックスをつけてインポートした際に予期しないシンボルに変換される不具合が修正されました。
• make-variable-transformerが可視なシンボルを不可視にする不具合が修正されました。
• exact-integer-sqrtに巨大数を与えると無限ループする不具合が修正されました。
• #!でモードを指定していないライブラリをロードした際に予期せぬコンパイル結果を起こす不具合が修正されました。

改善点

• (expt 2 x)のパターンが最適化されました。
• マクロ展開器が可能な限り先にマクロを展開するようになりました。
• 未束縛な識別子をコンパイラが検出し、R6RSモードなら&undefinedを互換モードなら警告を出すようになりました。警告は-Ewarn以上のオプションをつけて起動した場合に表示されます。
• bytevector-fill!手続きがオプション引数startとendを取るようになりました。

新たに追加された機能

• crc32及びadler32手続きが(rfc zlib)に追加されました。
• split-key、combine-key-components及びcombine-key-components!手続きが(crypto)に追加されました。
• ->odd-parity手続きが(util bytevector)に追加されました。
• (tlv)ライブラリがDGIスタイルのTLVをサポートするようになりました。

新たに追加されたライブラリ

• バイナリパック、アンパックライブラリ(binary pack)が追加されました。

非互換な変更点

• 実行時の未束縛なシンボルに対するエラーが&assertionから&undefinedに変更されました。

マクロ展開

Sagittariusのマクロ展開のタイミングを他のtoplevelと同じではなく、多少先んじて行うようにしたのだが、その際にふと以下のコードはR6RS的にはOKなのか気になった。

#!r6rs
(library (foo)
    (export d)
    (import (rnrs))

  ;; def ;; <- NG?
  (define-syntax def
    (lambda (x)
      (syntax-case x ()
        (k
         (with-syntax ((d (datum->syntax #'k 'd)))
           #'(define d 'ok))))))
  def ;; OK
  )

#!r6rs
(import (rnrs) (foo))
d

NG?っとマークが打ってある行なのだが。OKのマークの行は正しく動くべきだと思っているのだけど(Ypsilonはエラーになった、ChezはOK、Moshは現在手元にない)、マクロの展開がコンパイルされる前に行われるのであれば、NG?の部分もvalidな気がするんだけど、どうなんだろう？(ちなみに、パターンの部分を普通のマクロ(？)形式にすると当然Ypsilonでも動く。)

正直これがだめでも困ることはないんだけど、現状の実装ではこれをはじくことができない(実装方針は一つ前の投稿に書いてあるのでそっちを見て) 。ものすごく頑張ればいけるような気もするけど、割とどうでもいいエラー処理な気がするのでたぶん放置すると思う。問題になってから考えればイイ系。

マクロ展開のタイミング

R6RSポータブルなコードを書く際に、書く処理系の癖を熟知してなんてことよほど暇じゃないと出来ないだろうということに気付いた。現状で一番問題になっているのはマクロ展開フェーズ周りの処理である。

Sagittariusはマクロ展開フェーズなんてまどろっこしいものを持たないのだが、なんとかしてそれっぽくエミュレートできないかということちょっと知恵を搾り出し中(正直、搾取しすぎて搾りかすしか出ないが・・・)。とりあえず、library内のtoplevelなdefine-syntaxについては強引に先にやってしまうおう的に解決。(一度library内のtoplevelにある式を全部舐めて、define-syntaxだけ先にコンパイルするという割とお粗末な解決方法。なので、マクロ展開後に出てくるdefine-syntaxとかは対応してない。やろうと思えば出来る気もするが・・・)。頑張ってもう少し賢くした。R6RSより多少制限がゆるいけど。

問題になってくるのは局所マクロである。

R6RSでは以下のようなコードが動かないといけない。

(import (rnrs))
(let ()
  (define-syntax define-inline
    (syntax-rules ()
      ((_ (name . args) body ...)
       (define-syntax name
         (syntax-rules ()
           ((_ . args)
            (begin body ...)))))))

  (define (puts args) (display args) (newline))
  (define-inline (print args) (puts args))
  (print "abc"))
;; abcを表示

(let ()
  (define-syntax define-inline
    (syntax-rules ()
      ((_ (name . args) body ...)
       (define-syntax name
         (syntax-rules ()
           ((_ . args)
            (begin body ...)))))))
  (define-inline (print args) (puts args))
  (define (puts args) (display args) (newline))
  (print "abcde"))
;; abcdeを表示

最初のパターンは何とか(そこそこスマートに)解決できたんだけど、次のパターンのうまい方法が思いつかない。

起きていることそしては、define-inlineで展開されたprintはputsが内部defineとして保持される前にコンパイルされる。そうするとprintのマクロ展開器はputsが内部defineだと知らないので展開器は特に環境情報を付加することなくシンボルputsを識別子に変換する。っで、コンパイラは何も持ってない識別子を大域変数と解釈しコンパイルする。

コンパイラが上記のputs識別子から内部defineのputsを参照できればいいのだが、本当に何の情報も持っていない識別子の参照を許すとマクロのhygieneを壊してしまうのでうかつなことはできない。さて、どうしたものか・・・

make-variable-transformerに潜む罠

正確には、潜んでいる(進行形)か、潜んでいた(過去形)の方がいいのだろうか？

コード見て原因を確認していないんだけど、動き的に何が起きているのか分かったのでとりあえず書く。問題になるのは以下のコード。

#!r6rs
(import (rnrs))

(define-syntax pack
  (make-variable-transformer
   (lambda (x)
     (syntax-case x ()
       ((_ fmt vals ...)
        #'(begin vals ...))))))

(define-syntax define-crc
  (lambda (x)
    (syntax-case x ()
      ((k)
       (with-syntax ((crc-finish (datum->syntax #'k 'crc-finish)))
         #'(define (crc-finish r) r))))))

(let ((a 1))
   (define-crc)
   (pack "<C" (crc-finish a)))

上記のコードは0.4.1では実行時に、0.4.2(HEAD)ではコンパイル時にunbound variableエラーがでる。何が問題かと言えば、おそらくvariable transformerは実行時の環境ではなくマクロ捕捉時の環境で入力式をラップしているのが問題のはず。解決策は実行時環境でラップすればいいだけだと思うのだが、何でマクロ捕捉時の環境使っているのか確認しないといけない(推測が正しければ)。

さて、上記のコードは再現できる最小規模のコードなのだが、このバグを発見できたのはコンパイラが未束縛の識別子を検出するようにしたからである。もともとR6RS的にはコンパイル時に検出してエラーにしなければいけないんだけど、面倒だなぁと思ってサボっていた。っで、いろいろいじっているうちに下地が整ったというか、なんか簡単に検出できるようになっていたので、えいやっと実装してみたという感じである。
実装自体は非常に簡単だったのだけど、問題は既存のライブラリからごろごろと警告が出てきたので全て修正する方が大変だったことだろう。総称関数とか微妙に挙動を変えないとどうしようもないなぁとかだったし。

何はともあれこの修正でマクロ周りのバグがコンパイル時に発見できるようになったのでいろいろ便利になったと思う。

define-constant

MessagePackのR6RS Scheme用ライブラリを書いてたときにふと思いついたマクロ。

(import (for (rnrs) run expand)
        (for (rnrs eval) expand))

(define-syntax define-constant
  (lambda (x)
    (define (eval-expr k expr)
      (if (pair? (syntax->datum expr))
          (let ((r (eval (syntax->datum expr) (environment '(rnrs)))))
            (datum->syntax k r))
          expr))
    (syntax-case x ()
      ((k name expr)
       (with-syntax ((value (eval-expr #'k #'expr)))
         #'(define-syntax name
             (lambda (y)
               (syntax-case y ()
                 (var (identifier? #'var) value)))))))))

(define-constant const-1 1)
(define-constant const-2^16 (expt 2 16))

(display const-1) (newline)
(display const-2^16) (newline)

仕組みは簡単で、マクロとして束縛しつつ、define-constantマクロ展開時にexprを実行しておいてしまおうというだけのもの。込み入ったことはできないけど、(expt 2 16)とか見たいな(rnrs)の中だけで済ませられるものに対しては有効ではある。

Sagittariusには構文としてdefine-constantがあって、それで定義されたものはコンパイル時に定数として畳み込まれるんだけど、MoshやYpsilonにはない。しかも、2^16とかいいけど、もっとデカイ数字になったときにわざわざ数値リテラルで嫌だなぁと思い書いてみた。結局使ったの(expt 2 32)までだけど・・・

これと似たようなので、Vicareの中の人がよく使っている、define-inlineってのがある。こういう、コンパイラを当てにしないコードってポータブルなコードを書くときにはよく使われるのだろうか？