Perl XS メモ - typemap と MAGIC をからめて

id:tokuhirom さんが http://d.hatena.ne.jp/tokuhirom/20081209/1228829454 で下地をつくってくださったので(perl-users.jp むけまとめも期待してます),ちょっとアドバンスドな話題を。

例題 http://www.sra.co.jp/people/m-kasahr/eb/

http://www.sra.co.jp/people/m-kasahr/eb/Perl binding を開発するとしましょう。

http://www.sra.co.jp/people/m-kasahr/eb/ の使い方は,たとえば次のような感じです。

EB_Book *book_pointer;

book_pointer = (EB_Book *) malloc(sizeof(EB_Book));
eb_initialize_book(book_pointer);

if (eb_bind(&book, "ebnet://localhost/cdrom") != EB_SUCCESS) {
    printf("eb_bind() failed\n");
    return;
}

eb_finalize_book(book_pointer);
free(book_pointer);

各関数の頭に非透過構造体のポインタを渡すタイプの,よくあるオブジェクト指向的 C ライブラリです。一般的には EB_Book 構造体ポインタを作成するのに

EB_Book *book_pointer = eb_create_book();	// ←実在しません

みたいな形式のコンストラクタが設定されているライブラリも多いですが,まぁそれでも応用がきくと思います。

MAGIC とは

MAGIC とは任意の SV インスタンスにかけることのできる「魔法」のことです。

くわしくは

を参照してください。

MAGIC のなかに MAGIC-ext というユーザ定義情報を SV の中に隠し持つことのできるのものがありますので,今回はそれを使います*1

イニシャライザの実装

まずは(eb_initialize_book() に対応する)イニシャライザの実装からおこないます。

MODULE = EBook::EBLibrary    PACKAGE = EBook::EBLibrary

void
_attach_new_book(sv)
        SV *sv;
    PREINIT:
        EB_Book *book;
    CODE:
        Newx(book, sizeof(EB_Book), EB_Book);
        eb_initialize_book(book);

        sv_magic(SvRV(sv), NULL, PERL_MAGIC_ext, NULL, 0);
        mg_find(SvRV(sv), PERL_MAGIC_ext)->mg_obj = (void *) book;

PREINIT: とは,C での自動変数(スタック上変数)を宣言するものです。そういえば XS 部分のコードって {} で囲まれていませんもんね。malloc() の代わりに Newx() を使っていますが,前半部分はほぼそのままです。

後半が MAGIC をかけているところです。

  1. sv_magic(rv, , PERL_MAGIC_ext, , )MAGIC_ext な魔法をかけて
  2. mg_find(rv, PERL_MAGIC_ext)MAGIC_ext 部分の構造体を取得
  3. その構造体内に,たったいま確保した *book を格納

しています。

今後,いま格納した *book をあとで取り出したいときは,

(EB_Book *) mg_find(SvRV(sv), PERL_MAGIC_ext)->mg_obj

のようにするととれます。って今の手順の2番そのものですが。


さて,Perl module 側のコードです。

package EBook::EBLibrary;

use strict;
use warnings;

our $VERSION = '0.01';

require XSLoader;
XSLoader::load('EBook::EBLibrary', $VERSION);

sub new {
    my ($class) = @_;
    my $self = bless {}, $class;
    _attach_new_book($self);
    return $self;
}

sub DESTROY {
    my $self = shift;
    _destroy_book($self);
}

require Exporter;
our @ISA = qw( Exporter );
our @EXPORT_OK = qw( EB_SUCCESS );

sub EB_SUCCESS() { 0 }

1;

説明の順序が前後しましたが,Perl 側は一見通常のクラスインスタンス,ほんとの実体へのポインタを MAGIC_ext に格納する場合,わたしは上記のようにインスタンスの確保(つまり new)自体は Perl 側でやるのが好みです。

ファイナライザの実装と typemap

さて,次にファイナライザの実装です。

void
_destroy_book(book)
        EB_Book *book;
    CODE:
        eb_finalize_book(book);
        Safefree(book);

eb_finalize_book() して,free() のかわりに Safefree() しているだけです。おおもとのコードとほぼ同じですね。

でも引数として EB_Book * を要求しています。さきほどの Perl module の DESTROY() では

    _destroy_book($self);

のように呼び出していました。引数は SV * でなくて大丈夫なのでしょうか?

大丈夫です。このために typemap を使います。


typemap とは,XS の関数の「引数(INPUT)」や「戻り値(OUTPUT)」を自動的に変換するためのしくみです。

今回のコードでの typemap ファイルを下記に示します。

TYPEMAP
EB_Error_Code           T_IV
EB_Book *               T_EB_BOOK

INPUT
T_EB_BOOK
    $var = (EB_Book *) mg_find(SvRV($arg), PERL_MAGIC_ext)->mg_obj;

EB_Error_Code という型を T_IV すなわち符号つき整数値にマッピングしています。これは通常の typedef みたいなものですね。こうすると,

EB_Error_Code eb_set_error(new_error)
    EB_Error_Code new_error

のように XS を書くことができて,

my $new_error = 10;
my $result = eb_set_error($new_error);

のように Perl から普通の(即値含む)SV を引数として渡しても自動的に IV の値を取り出してくれますし,戻り値も C 側が int で返した値を自動的に SV as IV に変換してくれます。


で,いっぽう,EB_Book * ですが,これを T_EB_BOOK という独自型として定義しています。この独自型の変換ルールを指定するのが,後段の INPUT(や OUTPUT)ブロックです。再掲しますが

INPUT
T_EB_BOOK
    $var = (EB_Book *) mg_find(SvRV($arg), PERL_MAGIC_ext)->mg_obj;

これは,T_EB_BOOK という独自型について,関数の引数として渡された場合(INPUT)は上記のコードで変換してよね,という意味です。ご覧になればわかるとおり,$arg が変換元の引数,$var が変換後の引数に置換されます。


上記では一行で書きましたが,ある程度複雑なロジックを書くことも可能です。実際,わたしは

INPUT
T_EB_BOOK
    if (SvOK($arg) && SvROK($arg))
        $var = (EB_Book *) mg_find(SvRV($arg), PERL_MAGIC_ext)->mg_obj;
    else
        $var = NULL;

のような実装を使っています。もっと複雑になる場合は,あらかじめマクロを定義しておいてそれを呼び出す(←Text::MeCab で使われている手法)か,static 関数を定義しておいてそれを呼び出すかすることもできます。

各メソッドの実装とサンプルプログラム

次に

EB_Error_Code eb_bind (EB_Book *book, const char *path)

というメソッドの binding を実装してみましょう。

MODULE = EBook::EBLibrary    PACKAGE = EBook::EBLibrary

EB_Error_Code
eb_bind(book, path)
        EB_Book *book;
        const char *path;

はいこれだけです。

あれ?関数の実体がない!そう,typemap をうまく使うと関数の実体を書く必要がなくなります。

もし実体を書くと以下のような感じになるでしょう。

EB_Error_Code
eb_bind(book, path)
        EB_Book *book;
        const char *path;
    CODE:
        RETVAL = eb_bind(book, path);
    OUTPUT:
        RETVAL

このように,XS 側の関数が,外部の同じ名前の関数を同じインタフェースで呼び出す場合,実体を書く必要がないのです。これが typemap の醍醐味です。

なお,const char * という引数についてとくに typemap を指定しませんでした。このように一般によく使われる型についてはすでに typemap が定義されています。具体的にどのような型が定義されているのかは,ExtUtils::typemap ファイルを参照してみてください。


さて,Perl module 側の実装ですが……これは必要ありません。いままでに実装したコードを使ったサンプルをみていただければわかると思います。

use strict;
use warnings;
use EBook::EBLibrary;

my $book = EBook::EBLibrary->new();

if ($book->eb_bind('ebnet://localhost/cdrom') != EB_SUCCESS) {
	print {*STDERR} "eb_bind() failed", "\n";
    exit;
}

# $book will be DESTROYed automatically

一番最初の C のプログラムを見事 Perl コードに落とし込むことができました。

で,

$book->eb_bind('ebnet://localhost/cdrom');

という部分ですが,$bookEBook::EBLibrary に bless されている場合,

EBook::EBLibrary::eb_bind($book, 'ebnet://localhost/cdrom');

と等価になります。なので Perl module 側でどうこうする必要がなかったんですね。

Perl サイドのメソッド名を PREFIX をつけて加工

しかし,

$book->eb_bind('ebnet://localhost/cdrom');

という部分は,ちょっとメソッド名としてかっこ悪いですよね。

$book->bind('ebnet://localhost/cdrom');

という呼び出し方が理想的です。

素直に XS code を書くとすると,

MODULE = EBook::EBLibrary    PACKAGE = EBook::EBLibrary

EB_Error_Code
bind(book, path)
        EB_Book *book;
        const char *path;
    CODE:
        RETVAL = eb_bind(book, path);
    OUTPUT:
        RETVAL

のようになるでしょうか。しかし,せっかく関数の実体を排除したのに,また書かなくてはいけなくなりました。

このようなときに使うのが [http://perldoc.perl.org/perlxs.html#The-PREFIX-Keyword:title=PREFIX] キーワードです。

MODULE = EBook::EBLibrary    PACKAGE = EBook::EBLibrary    PREFIX=eb_

EB_Error_Code
eb_bind(book, path)
        EB_Book *book;
        const char *path;

このように PREFIX=eb_ と指定すると,Perl 側に晒される XS のインタフェースが eb_ を削除したもの = bind() になります。XS code の実体を書く必要がなくなりました。

このように改変した上で XS をビルドすれば

$book->bind('ebnet://localhost/cdrom');

のように書けるようになります(EBook::EBLibrary::bind() として定義された)。

ライブラリ関数を同名でラップする際にも PREFIX は使える

つぎに下記の関数の binding を実装することを考えてみます。

EB_Error_Code eb_subbook_title (EB_Book *book, char *title)

関数 eb_subbook_title() は、book が選択中の副本の題名を title の指す領域に文字列として書き込みます。題名の文字列の長さは、最長で EB_MAX_TITLE_LENGTH バイトです。この長さは、末尾のナル文字を含みません。

eb_subbook_title()

ふむ。あらかじめ *title にバッファを確保しとかないといけないんですね。

Perl 側からのインタフェースは

my $title;

my $result = $book->eb_subbook_title(\$title);

のようにすることにします(もちろん title を返すほうがかっこいいのですが,例題ですので)。

もし実直に XS code binding を書くと,呼び出し側は,

my $title = ' ' x (EB_MAX_TITLE_LENGTH + 1);

my $result = $book->eb_subbook_title(\$title);

のように,あらかじめバッファを確保する必要があります。しかしユーザーフレンドリーじゃないですね。


今回は素直にラッピング関数を書きましょう。

/*
 *  MODULE=〜 が始まる前に書く
 */

static EB_Error_Code
xs_eb_subbook_title(book, sub_title)
        EB_Book *book;
        SVREF sub_title;
{
    EB_Error_Code r;
    char title[EB_MAX_TITLE_LENGTH + 1];

    r = eb_subbook_title(book, title);
    if (r == EB_SUCCESS) {
        sv_setpv_mg(sub_title, title);
    }
    else {
        SvSetSV(sub_title, &PL_sv_undef);
    }

    return r;
}

XS code ではなく,通常の C 関数として書きました。やっぱり落ち着きますね。

で,これを XS code から呼び出すわけですが,

MODULE = EBook::EBLibrary     PACKAGE = EBook::EBLibrary    PREFIX = xs_

EB_Error_Code
xs_eb_subbook_title(book, sub_title)
        EB_Book *book;
        SVREF sub_title;

これで,Perl 側で eb_subbook_title() を呼び出すと XS code 側の xs_eb_subbook_title() が呼び出され,そこから static 関数の xs_eb_subbook_title() が呼び出されることになります。

さきほどの流儀にしたがうと PREFIX = xs_eb_ としたほうがいいかもしれないですが。

ちょっと待って!同じ名前の関数を定義しているよ!

ということに気づいた方は鋭い!(より前の段階から気づいていたかもしれませんが)

いまのコードを結合すると,下記のようになります。

static EB_Error_Code
xs_eb_subbook_title(book, sub_title)
        EB_Book *book;
        SVREF sub_title;
{
	/* ...... snip snip snip ...... */
}

MODULE = EBook::EBLibrary     PACKAGE = EBook::EBLibrary    PREFIX = xs_

EB_Error_Code
xs_eb_subbook_title(book, sub_title)
        EB_Book *book;
        SVREF sub_title;

普通に C のコードとして考えると,xs_eb_subbook_title() というシンボルが重複しているように感じます。

そもそも,eb_bind() に関しても

MODULE = EBook::EBLibrary    PACKAGE = EBook::EBLibrary    PREFIX=eb_

EB_Error_Code
eb_bind(book, path)
        EB_Book *book;
        const char *path;

と書いていました。最終的に XS ライブラリを EB ライブラリとリンクするわけですが,EB ライブラリには eb_bind() というシンボルが含まれます。XS の eb_bind()eb_bind() という関数を呼び出していますが,これは自分自身を呼び出してしまうのではないでしょうか。


その謎は,EBLibrary.xs ではなく,自動生成された EBLibrary.c を見ると氷解します。

XS(XS_EBook__EBLibrary_eb_bind)
{
    dXSARGS;
    if (items != 2)
        Perl_croak(aTHX_ "Usage: EBook::EBLibrary::eb_bind(book, path)");
    {
        EB_Book *       book;
        const char *    path = (const char *)SvPV_nolen(ST(1));
        EB_Error_Code   RETVAL;
        dXSTARG;

        if (SvOK(ST(0)) && SvROK(ST(0)))
            book = (EB_Book *) mg_find(SvRV(ST(0)), PERL_MAGIC_ext)->mg_obj;
        else
            book = NULL;

        RETVAL = eb_bind(book, path);
        XSprePUSH; PUSHi((IV)RETVAL);
    }
    XSRETURN(1);
}

MODULE=〜 ブロック以下でかかれた XS code は上記のように実際は XS_EBook__EBLibrary_eb_bind() のようなシンボルになっています*2

これは xsubpp コマンドが .xs コードを .c に変換するときにおこなっていることです。一見複雑なしくみですが,これらのメカニズム ―― xsubpp と typemap ―― がうまくはたらくことで,既存の C ライブラリの binding を記述することが簡単になっているのです。

おわりに

とまあ以上のように書いてきましたが,さきほどの eb_subbook_title() の例のように,C のライブラリをそのまま bind すると Perl の作法と相容れない場合もあります。

そんなときは,たとえば EBook::EBLibrary::API で low level layer な binding を提供し,より OO-ish なモジュールを Pure Perl で書くというのも一つの方策です。第一引数としてインスタンスポインタを渡すタイプではない C ライブラリの binding の場合も応用がききますし。

*1:ほんとはイベントハンドラとかいろいろおもしろいこともできるらしいのですが。今回のネタは MAGIC の力のほんの一部です。

*2:さらにいうと,前半部分で typemap で定義した変換用コードが挿入されていることもわかります。