root/websites/perl-users.jp/ttroot/expert_perl/xscodetemplate.html @ 29168

Revision 29168, 9.6 kB (checked in by otsune, 4 years ago)

set title

  • Property svn:executable set to *
Line 
1[% WRAPPER expert_perl/wrapper.tt,
2    last_modified => '$Date$'
3-%]
4[%- SET title = 'XS code template - 動的にXSUBを生成する' -%]
5[% USE Markdown %][% FILTER markdown %]
6
7XS code template - 動的にXSUBを生成する
8=========================================================
9
10XSコードはふつうPerlコードよりも多機能で高速ですが，書くのが難しいため敷居が高いことも事実です。また，いちいちコンパイルしなければならないのも煩わしい点です。
11ところで，Perlにはクロージャという仕組みがあり，動的にコードを生成することができます。したがって，XSでクロージャに等しいことを実現できれば，XSコードの煩わしさを避けつつXSの利益を享受することができます。
12
13なお，この文書はXSによるコード例を解説していますが，XSそのものについては解説しません。
14XSについてはperlxstutやperlxs，perlapiを参照してください。
15
16
17クロージャの分析
18---------------------------------------------------------
19
20まず，Perlのクロージャを分析します。Perlのクロージャは以下のようなものです。
21
22    sub make_accessor{
23        my($name) = @_;
24
25        return sub{ $_[0]->{$name} };
26    }
27
28    my $foo_accessor = make_iterator('foo');
29    my $bar_accessor = make_iterator('bar');
30
31    my $o = { foo => 42, bar => 3.14 };
32
33    say $foo_accessor->($o); # => 42
34    say $bar_accessor->($o); # => 3.14
35
36このmake_accessor()が生成するものがクロージャです。このクロージャを分析すると，二つの要素，すなわち一連の「手続き」(最初の引数にアクセスし，ハッシュの要素を参照する)と，その手続きに結び付けられる「値」($name)からなっていることが分かります。「手続き」部分は静的に決定できますし，「値」は単にPerlの値(SV)ですから，このクロージャの二つの要素をXSで書くことに制約はありません。あとは「値」をうまく「手続き」と結びつけることができれば，XSによるクロージャを実現できることになります。
37
38
39ひとまず用語を整理しましょう。
40まず，クロージャを生成するコード(上記の例ではmake_accessor())をコードの**ジェネレータ**と呼ぶことにします。また，「手続き」はコードの**テンプレート**，「値」は**パラメータ**とそれぞれ呼ぶことにしましょう。また，Perlのクロージャと区別するため，以後はXSで作成するクロージャを**テンプレートインスタンス**と呼ぶことにします。
41
42実装の方法
43---------------------------------------------------------
44
45テンプレートとパラメータを結びつけるということは，コードがデータを持つことができなければいけません。
46
47一つ目の考え方は，FieldHashを使うというものです。FieldHashとは，オブジェクトをキー，そのオブジェクトのプロパティを値とするハッシュで，そのオブジェクトが開放されると自動的にFieldHashのそのオブジェクト用のエントリが削除される特殊なハッシュです。この機能はXSからも使用できるため，XSコードが自分自身のcvのアドレスをキーとすることで，コードがデータを持つことができます。したがって，FieldHashを用いてテンプレートを実現することができます。しかし，FieldHashのアクセスに掛かるオーバーヘッドは非常に大きいので，速度のためにXSを用いる意義が減少してしまいます。
48
49
50二つ目の考え方は，XSUBのフリースロットであるXSUBANYを使うものです。これはClass::XSAccessorが採用している方法ですが，これは正しくプロパティを開放するのが難しいため，最適とはいえません。
51
52三つ目の考え方は，全てのSV（XSUBもSVの一種です）が持つことのできるフリースロットであるVariable Magic Slotを使うというものです。これはテンプレートインスタンスの生成もプロパティへのアクセスも高速であり，テンプレートインスタンスの消滅と共に全てのプロパティがきちんと開放され，しかも比較的実装が容易です。ここでは，このVariable Magicによるテンプレートの実装を解説します。
53
54実装例
55---------------------------------------------------------
56
57実装例として，アクセサメソッドを生成するmix-inクラスを取り上げます。
58
59使用法は以下の通り：
60
61    # Course.pm
62    package Course;
63    use parent qw(Class::Accessor::XS);
64    __PACKAGE__->mk_accessors(qw(id title teachers description)));
65
66    sub new{ ... }
67
68    # script.pl
69    use Course;
70    my $c = Course->new();
71    $c->id(42);
72    $c->title('Psychology I');
73
74実装は次の通り：
75
76    /* XS.xs */
77    #define PERL_NO_GET_CONTEXT
78    #include "EXTERN.h"
79    #include "perl.h"
80    #include "XSUB.h"
81
82    #include "ppport.h"
83
84    /* Magic識別子: &accessor_identityはプログラム中で一意の値を持つ */
85    MGVTBL accessor_identity;
86
87    /* MGVTBLを識別子としてSVからmgを検索する */
88    /* see also Perl_mg_find() in mg.c */
89    static MAGIC*
90    my_mg_find_by_vtbl(pTHX_ SV* const sv, const MGVTBL* const vtbl){
91        MAGIC* mg;
92        for(mg = SvMAGIC(sv); mg; mg = mg->mg_moremagic){
93            if(mg->mg_virtual == vtbl){
94                break;
95            }
96        }
97        return mg;
98    }
99
100
101    /* code template */
102    XS(XS_Class_Accessor_XS_accessor); /* to pass -Wmissing-prototypes */
103    XS(XS_Class_Accessor_XS_accessor){
104        dVAR; dXSARGS;
105
106        SV* self;
107        /* XSUBに結び付けられたMAGICオブジェクトを検索する */
108        MAGIC* const mg = my_mg_find_by_vtbl(aTHX_ (SV*)cv, &accessor_identity);
109        assert(mg);
110
111        if(items < 1 || items > 2){
112            Perl_croak(aTHX_ "Usage: $obj->%"SVf, mg->mg_obj);
113        }
114
115        self = ST(0); /* $_[0] */
116
117        if(!(SvRV(self) && SvTYPE(SvRV(self)) == SVt_PVHV)){
118            Perl_croak(aTHX_ "Not a HASH reference");
119        }
120
121        SP -= items;
122        {
123            HV* const obj    = (HV*)SvRV(self);
124            SV* const key    = mg->mg_obj; /* テンプレートのパラメータ */
125            U32 const hash   = (U32)XSANY.any_i32;
126            SV* retval;
127
128            if(items == 1){ /* read */
129                HE* const slot = hv_fetch_ent(obj, key, FALSE, hash);
130                retval = slot ? hv_iterval(obj, slot) : &PL_sv_undef;
131            }
132            else{ /* write */
133                retval = newSVsv(ST(1));
134                hv_store_ent(obj, key, retval, hash);
135            }
136
137            ST(0) = retval;
138            XSRETURN(1);
139        }
140    }
141
142    MODULE = Class::Accessor::XS    PACKAGE = Class::Accessor::XS
143
144    PROTOTYPES: DISABLE
145
146
147    void
148    mk_accessors(SV* klass, ...)
149    PREINIT:
150        I32 i;
151    CODE:
152        /* code generator */
153        for(i = 1; i < items; i++){
154            SV* const name       = ST(i);
155            SV* const fq_name    = newSVpvf("%"SVf"::%"SVf, klass, name);
156            STRLEN pvlen;
157            const char* const pv = SvPV_const(fq_name, pvlen);
158           
159            /* テンプレートインスタンスを作成する */
160            /* なお，newXS()の第一引数がNULLだと匿名関数になる */
161            CV* const xsub       = newXS(pv, XS_Class_Accessor_XS_accessor, __FILE__);
162            U32 hash;
163
164            /* テンプレートインスタンスを初期化する */
165
166            /* ハッシュ値を計算しておく */
167            PERL_HASH(hash, pv, pvlen);
168            CvXSUBANY(xsub).any_i32 = (I32)hash;
169
170            /* テンプレートとパラメータを結びつける */
171            sv_magicext((SV*)xsub, fq_name, PERL_MAGIC_ext, &accessor_identity, NULL, 0);
172            SvREFCNT_dec(fq_name); /* refcnt++ in sv_magixext() */
173        }
174
175
176この中では，CセクションにあるXS_Class_Accessor_XS_accessor()がテンプレートで，XSセクションにあるmk_accessors()がジェネレータです。
177newXS()が返すXSUBにsv_magicext()でMAGICオブジェクトをセットしており，テンプレート内のmy_mg_find_by_vtbl()でXSUBからMAGICオブジェクトを取り出します。なお，このmy_mg_find_by_vtbl()は相当する機能をPerlが提供していないため，独自に定義しています。
178
179この例では更にXSUBのフリースロットであるXSUBANYを利用してハッシュ値をあらかじめ計算してあります。
180また，XS_Class_Accessor_XS_accessor()はXSUBであるため，xsubppが自動的に生成するはずのコードもすべて自分で書いています。これは，たとえばaccessor_template()などとしてXSセクションに書いてもいいのですが，その場合にはモジュールの外部から呼ばれないように，XS.pm中でサブルーチン&Class::Accessor::XS::accessor_template()を削除する必要があります。
181
182このClass::Accessor::XSの実行可能な完全なバージョンはCodeReposにあります。
183
184* svn co <http://coderepos.org/share/browser/lang/perl/Class-Accessor-XS>
185
186SEE ALSO
187---------------------------------------------------------
188
189* [Data::Util](http://search.cpan.org/dist/Data-Util/)のcurry()とmodify_subroutine()はここで説明した方法でコードテンプレートを実現しています
190* [Class::XSAccessor](http://search.cpan.org/dist/Class-XSAccessor)は別の方法でコードテンプレートを実現しています
191
192[% END %]
193[% END %]
194
Note: See TracBrowser for help on using the browser.