理系学生日記

おまえはいつまで学生気分なのか

XS の ST を使ってみようとしたらハマった

Perl では XS に限らず,どうも関数に渡した引数,そし関数からの返り値はスタックに溜められるらしいんですが,そこ(スタック)の値を参照するのに ST(x) というマクロを使えるみたいです.x はスタックの場所を指す数字で,配列のインデクスと同じく 0 から始まります.だいたいにおいては,xsubpp が typemaps ファイルを見て,自動的にスタック参照コードを埋め込んでくれますが,他のケースではプログラマがんばれよ!とのこと.
というわけで,とりあえず一度試してみますか.

int
arg_test( int i1, int i2 )
    CODE:
        RETVAL = ST(1);
    OUTPUT:
        RETVAL

じつはこれ,うまく動きません.Perl から String::arg_test(1,2) を呼んで返ってくるのはとんでもない数字でした.なぜなのか,xsubpp が生成した C のソースを読んでみます.

XS(XS_String_arg_test); /* prototype to pass -Wmissing-prototypes */
XS(XS_String_arg_test)
{
    dXSARGS;
    if (items != 2)
        Perl_croak(aTHX_ "Usage: String::arg_test(i1, i2)");
    {
        int     RETVAL;
        dXSTARG;
        int     i1 = (int)SvIV(ST(0));
        int     i2 = (int)SvIV(ST(1));
#line 20 "String.xs"
        RETVAL = ST(1);
#line 52 "String.c"
        XSprePUSH; PUSHi((IV)RETVAL);
    }
    XSRETURN(1);
}

RETVAL に代入する場所で ST が呼ばれている以前に,実引数に代入するところで既に ST が呼ばれています.変な数字が返ってきたのは,この ST の呼び出しによってスタックの内容が変化したというのが可能性としてありそうです.ST の内容はどうなってるんでしょうか.
h2xs が生成するコードには必ず以下のヘッダファイルが読み込まれています.

#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"

#include "ppport.h"

この中で ST が定義されているのは,XSUB.h です.定義は以下.

#define ST(off) PL_stack_base[ax + (off)]

PL_stack_base が スタックを表現する配列みたいですね.ax はなんだろうか.PL_stack_base に関しては,なかなか見つけられなかったんですけど,Web でしらべてたらこんな議論を見つけた.

A few hundred macros eventually transform PL_stack_base into Tstack_base which is then inserted into 'struct interpreter' via thrdvar.h (see perl.h). The actual definition is done with
PERLVAR(Tstack_base, SV **);
which translates into
SV ** Tstack_base;

http://coding.derkeiler.com/Archive/Perl/comp.lang.perl.misc/2004-04/2133.html

あんまり深入りしてると時間がなくなりそうな感じ.ただ,少なくとも,マクロ ST の呼び出しで,スタックは壊れないんじゃないのかなー.

ここでぼくはハッとしてしまったんですけども,

        int     i2 = (int)SvIV(ST(1));

おいなんか.ST マクロの結果を SvIV マクロに渡して,しかも int にキャストしてるぜ!!!!
てわけで,こんな風にしたら,うまく動いてくれました.typemap のこと調べてたはずなのに...変換しないといけないこと忘れてた!!

XS(XS_String_arg_test); /* prototype to pass -Wmissing-prototypes */
XS(XS_String_arg_test)
{
    dXSARGS;
    if (items != 2)
        Perl_croak(aTHX_ "Usage: String::arg_test(i1, i2)");
    {
        int     RETVAL;
        dXSTARG;
        int     i1 = (int)SvIV(ST(0));
        int     i2 = (int)SvIV(ST(1));
#line 20 "String.xs"
        RETVAL = (int)SvIV( ST(1) );
#line 52 "String.c"
        XSprePUSH; PUSHi((IV)RETVAL);
    }
    XSRETURN(1);
}