もう忘れてしまってるのでよくわからん
perlから実行する時は
引数はPOP*で受け取る
これでperlからは
- 私的 XS メモ - IT戦記
- v8 (Google JavaScript Engine) を Perl XS モジュールにしてみた - daily dayflower
- Perl XS メモ - typemap と MAGIC をからめて - daily dayflower
- 複数ファイルを使った中規模 XS の開発 - daily dayflower
- XS(とC++)入門したい - はこべにっき#
- モダンなXSの書き方 - use GFx::WebLog;
- XSでCの文字列操作関数を使用するべきでない理由 - use GFx::WebLog;
- XS基礎文法最速マスター - Islands in the byte stream
- Perl Swig におけるSTLのvector/string typemap - ひげぽん OSとか作っちゃうかMona-
- XS - naoyaの日記 - naoyaグループ:
- Perl XS - dSP dXSTARG - D-6 相変わらず根無し
- 404 Blog Not Found:perl - BSD::getloadavg
- wakaponさんのよく☆ある☆ふつーの備忘帳: XS
- The Perl5 Manual 応用プログラムインタフェース
- Gluing C++ And Perl Together
- XS code template - 動的にXSUBを生成する - エキスパートPerl
- perlxs - XS 言語リファレンスマニュアル
- perlXStut - XSUB を書くためのチュートリアル
- perlguts - Perl API の紹介
- perlapi - perl public API の自動生成ドキュメント
- perlcall - C からの Perl 呼び出し規約
- perlxs - XS language reference manual - search.cpan.org
- perlguts - Introduction to the Perl API - search.cpan.org
- perlapi - autogenerated documentation for the perl public API - search.cpan.org
- perlcall - Perl calling conventions from C - search.cpan.org
- http://users.endeworks.jp/~daisuke/presentations/y...
- http://users.endeworks.jp/~daisuke/presentations/y...
- http://d.hatena.ne.jp/gfx/20100202/1265091606
- http://d.hatena.ne.jp/tokuhirom/20110105/129423382...
せっかくなのでC++にしたい場合。まずはいつものh2xs
h2xs -A -n CPPXSMakefile.PLを編集
# WriteMakefileの引数に追加 CC => "g++", LD => "g++",CPPXSディレクトリに移動してMakefile.PLを編集し、実行
perl Makefile.PLCPPXS.xsを編集
#ifdef __cplusplus extern "C" { #endif #include "EXTERN.h" #include "perl.h" #include "XSUB.h" #ifdef __cplusplus } #endif #include <iostream> using namespace std; MODULE = CPPXS PACKAGE = CPPXS void hello() CODE: cout << "hello" << endl;makeする
makeできたモジュールの中身をみてみる。XSが呼ばれているところはこのようになっている
require XSLoader; XSLoader::load('CPPXS', $VERSION);テスト用スクリプト作成 cppxs.pl
#!/usr/bin/perl use strict; use ExtUtils::testlib; use CPPXS; CPPXS::hello();テスト用スクリプト実行
perl cppxs.pl hello
たぶんどっちかっていうとこっちが主流?
Module::Starter, Module::Starter::PBPが必要なので、なければインストールする
Module::Starter, Module::Starter::PBPが必要なので、なければインストールする
# CPANPLUSもなかったのでついでに yum -y install perl-CPANPLUS perl-Module-Starter perl-Module-Starter-PBP次にModule::Starter::XSimpleが必要だが、これはyumにはないので、cpanpでインストール
cpanp i Module::Starter::XSimpleあとはmodule-starterを実行するときの--classにModule::Starter::XSimpleを指定する
module-starter --module=CPPXS --class=Module::Starter::XSimple --author=holly --email=your@mailaddressこれでh2xsをつかわなくても可能。ちなみにhttp://blog.clouder.jp/archives/001094.htmlこんなのもあるみたい。
PrintXSというパッケージを作る。初めは丁寧にやってみる
make
h2xs -A -n PrintXSPrintXSディレクトリのPrintXS.xsを編集。PerlIO_printfを使う
#include "EXTERN.h" #include "perl.h" #include "XSUB.h" #include "ppport.h" MODULE = PrintXS PACKAGE = PrintXS void stdout_print() CODE: PerlIO_printf(PerlIO_stdout(), "標準出力\n"); void stderr_print() CODE: PerlIO_printf(PerlIO_stderr(), "標準エラー出力\n");
make
perl Makefile.PL makeテストプログラム作成。printxs.pl
#!/usr/bin/perl use strict; use lib qw(./lib); use PrintXS; PrintXS::stdout_print(); PrintXS::stderr_print();実行
# 標準出力 perl printxs.pl 2>/dev/null # 標準エラー出力 perl printxs.pl > /dev/nullPerlIO_printfの第2引数に渡す変数はCのchar*型でないとだめなので、SV*とかの場合は
SvPVX(SV*)のようにして被参照を行うといいらしい。
BoolXSというpackageを作成としたして、BoolXS.xsを編集
#include "EXTERN.h" #include "perl.h" #include "XSUB.h" #include "ppport.h" #include <string.h> #include <stdbool.h> MODULE = BoolXS PACKAGE = BoolXS bool check_hoge(char* str) CODE: RETVAL = (strcmp(str, "hoge") == 0) ? true : false; OUTPUT: RETVALテストプログラム作成。boolxs.pl makeまで終わった段階で
#!/usr/bin/perl use strict; use lib qw(./lib); use BoolXS; my $str = shift; if(BoolXS::check_hoge($str)){ print "$str ok\n"; }else{ print "$str not ok\n"; }
get_svを使う。Hoge.pm内で
$Hoge::VERSION = '1.00';などとあって、Hoge.xsからこれを参照する場合
SV* version = get_sv("Hoge::VERSION", FALSE);とするとよい。第2引数はFALSEにしてるほうが無難。TRUEにすると変数が生成される
# こうするとxsから設定できる SV* sv = perl_get_sv("foo", TRUE); sv_setpv(sv, "bar"); SvPOK_on(sv);Double_Typed_SVs とか参考になる
HvName?(SvSTASH(SvRV(SV*)))を使うとcharで返って来るみたい
char * get_package_name_from_sv(SV * sv) INIT: char *pkg; CODE: if(sv_isobject(sv)){ pkg = HvNAME(SvSTASH(SvRV(sv))); }else{ Perl_croak(aTHX_ "Usage: get_package_name_from_sv(SV*). sv is not reference"); } RETVAL = pkg; OUTPUT: RETVALこのあたり参照 http://fleur.hio.jp/perldoc/mix/pod/perlguts.html#...
SV * new(...) INIT: char *classname; /* get the class name if called as an object method */ if ( sv_isobject(ST(0)) ) { classname = HvNAME(SvSTASH(SvRV(ST(0)))); } else { classname = (char *)SvPV_nolen(ST(0)); }Module::Starter::XSimpleを使うとこのようなnewを生成してくれる。引数が可変なので...であらわし、int itemsで受け取った引数の数を取得できる
PPCODEを使って、リストを返す
そしてリストを返す場合はPPCODE + XPUSHs**セットで使う(他にもやり方はあるだろうけど)
ただし返り値をRETVALで返す場合は**.cのほうで
あとはperl側から
#include "EXTERN.h" #include "perl.h" #include "XSUB.h" #include "ppport.h" #include <string.h> MODULE = Hoge PACKAGE = Hoge void get_list() PPCODE: char* c1 = "hoge"; char* c2 = "hage"; char* c3 = "uge"; XPUSHs(sv_2mortal(newSVpv( c1, strlen(c1) ))); XPUSHs(sv_2mortal(newSVpv( c2, strlen(c2) ))); XPUSHs(sv_2mortal(newSVpv( c3, strlen(c3) )));新たな変数を作るときはnewSV**で生成。newSV**で作成した変数に対しては必ずsv_2mortalをする。メモリリークを引き起こす原因らしい。
そしてリストを返す場合はPPCODE + XPUSHs**セットで使う(他にもやり方はあるだろうけど)
ただし返り値をRETVALで返す場合は**.cのほうで
ST(0) = RETVAL; sv_2mortal(ST(0));としてくれるので変数の揮発化(っていうらしい)は行う必要はない
あとはperl側から
my($c1, $c2, $c3) = Hoge::get_list();とすると受け取り可能。余談だがXPUSHsは引数スタックを自動的に拡張してくれる。あらかじめ返す引数の数がわかっている場合は
EXTEND(sp, 3);としてから
char* c1 = "hoge"; char* c2 = "hage"; char* c3 = "uge"; PUSHs(sv_2mortal(newSVpv( c1, strlen(c1) ))); PUSHs(sv_2mortal(newSVpv( c2, strlen(c2) ))); PUSHs(sv_2mortal(newSVpv( c3, strlen(c3) )));とすると速度がはやくなるようだ
&PL_sv_undefを使う。(&sv_undefでもいいみたい。XSRETURN_UNDEFでもいいような気がする)。
2010/9/30追加。newSV(0)らしい。NULL 型の空の SV を返す。ということだそうな。
2010/9/30追加。newSV(0)らしい。NULL 型の空の SV を返す。ということだそうな。
※ここからC++で。相変わらずあまりわかってないけど
あとはperl側から
Data::Dumperとか使ってたら結果は
#ifdef __cplusplus extern "C" { #endif #include "EXTERN.h" #include "perl.h" #include "XSUB.h" #include "ppport.h" #ifdef __cplusplus } #endif #include <iostream> #include <string> #include <vector> using namespace std; typedef vector<string> container; typedef container::iterator it; MODULE = Hoge PACKAGE = Hoge SV* get_arrayref() INIT: container v; AV* av = newAV(); CODE: v.push_back("hoge"); v.push_back("uge"); v.push_back("hage"); for(it i = v.begin(); i != v.end(); i++){ av_push(av, newSVpv((*i).c_str(), (*i).size())); } RETVAL = newRV_noinc((SV *)av); OUTPUT: RETVAL
あとはperl側から
my $arrayref = Hoge::get_arrayref();
Data::Dumperとか使ってたら結果は
$VAR1 = [ 'hoge', 'uge', 'hage' ];として結果が得られるはず。
ほとんど配列の時と変わらない
#ifdef __cplusplus extern "C" { #endif #include "EXTERN.h" #include "perl.h" #include "XSUB.h" #include "ppport.h" #ifdef __cplusplus } #endif #include <iostream> #include <string> #include <map> using namespace std; typedef map<string,string> hash; typedef hash::iterator it; MODULE = Hoge PACKAGE = Hoge SV* get_hashref() INIT: hash h; HV* hv = newHV(); CODE: h.insert(hash::value_type("apple", "りんご")); h.insert(hash::value_type("banana", "ばなな")); h.insert(hash::value_type("melon", "めろん")); for(it i = h.begin(); i != h.end(); i++){ // cout << (*i).first << ":" << (*i).second << endl; string key = (*i).first; string val = (*i).second; hv_store(hv, key.c_str(), key.size(), newSVpv(val.c_str(), val.size()), 0); } RETVAL = newRV_noinc((SV*)hv); OUTPUT: RETVAL
#ifdef __cplusplus extern "C" { #endif #include "EXTERN.h" #include "perl.h" #include "XSUB.h" #include "ppport.h" #ifdef __cplusplus } #endif #include <iostream> using namespace std; MODULE = CV PACKAGE = CV void want_cv(CV *code) PREINIT: CODE: call_sv((SV *)code, G_VOID);
perlから実行する時は
CV::want_cv(sub { print "あいうえお\n" });とすればよい
void want_cv(CV* code) PREINIT: CODE: I32 retnum = call_sv((SV *)code, G_SCALAR); // 引数があるならかならずチェック if(retnum != 1) { Perl_croak(aTHX_ "retnum is not 1(result: %i)", retnum); } PerlIO_printf(PerlIO_stdout(), "%s\n", POPp);
引数はPOP*で受け取る
- POPs SV
- POPp ポインタ
- POPn 倍精度
- POPi 整数
- POPl long 整数
void want_cv(CV* code) PREINIT: CODE: { ENTER; SAVETMPS; I32 retnum = call_sv((SV *)code, G_SCALAR); SPAGAIN; PerlIO_printf(PerlIO_stdout(), "%s\n", POPp); PUTBACK FREETMPS; LEAVE; }としておかないといけないのかもしれない。もう少し意味を調べる必要あり。 perlから実行する時は
CV::want_cv(sub { "あいうえお" });返り値が2つある場合は
void want_cv(CV* code) PREINIT: CODE: { ENTER; SAVETMPS; I32 retnum = call_sv((SV *)code, G_ARRAY); SPAGAIN; if(retnum != 2) { Perl_croak(aTHX_ "retnum is not 2(result: %i)", retnum); } PerlIO_printf(PerlIO_stdout(), "%s\n", POPp); PerlIO_printf(PerlIO_stdout(), "%s\n", POPp); PUTBACK; FREETMPS; LEAVE; }perlから実行する時は
CV::want_cv(sub { "あいうえお", "かきくけこ" });
void want_cv2(CV* code, int a, int b) PREINIT: CODE: { dSP; ENTER; SAVETMPS; PUSHMARK(SP); XPUSHs(sv_2mortal(newSViv(a))); XPUSHs(sv_2mortal(newSViv(b))); PUTBACK; call_sv((SV *)code, G_VOID | G_DISCARD); //PUTBACK; FREETMPS; LEAVE; }perlから実行する時は
CV::want_cv(sub { print $_[0] + $_[1]; print "\n" }, 100, 200);とすると第2, 3引数の合計値が出力される。
#ifdef __cplusplus extern "C" { #endif #include "EXTERN.h" #include "perl.h" #include "XSUB.h" #include "ppport.h" #ifdef __cplusplus } #endif #include <iostream> using namespace std; MODULE = Hoge PACKAGE = Hoge PROTOTYPES: ENABLE SV * new(SV *classname) INIT: SV *sv; HV *hv; HV *stash; CODE: // ハッシュを作成 hv = newHV(); // リファレンスにする sv = newRV_noinc((SV *)hv); // シンボルテーブル取得。trueはなければ作成 stash = gv_stashpv(SvPV_nolen(classname), true); // bless! sv_bless(sv, stash); RETVAL = sv; OUTPUT: RETVAL // helloメソッド void hello(SV *self) INIT: char *pkg; CODE: if(!sv_isobject(self)){ croak("can not call hello() on a non-object"); } pkg = HvNAME(SvSTASH(SvRV(self))); cout << "Hello, " << pkg << endl; OUTPUT:
これでperlからは
my $hoge = Hoge->new;とするとHogeのインスタンスを得ることができ、
$hoge->hello;を実行すると
Hello, Hogeと出力される
とでもいえばいいのか
typemapも必要
#ifdef __cpluscplus extern "C" { #endif #include "EXTERN.h" #include "perl.h" #include "XSUB.h" #include "ppport.h" #ifdef __cpluscplus } #endif #include <iostream> using namespace std; class ManCPP { private: char *name; int age; public: ManCPP(char *name, int age); ~ManCPP(); char * get_name(); int get_age(); void set_name(char *name); void set_age(int age); }; ManCPP::ManCPP(char *name, int age) { this->name = name; this->age = age; } ManCPP::~ManCPP() { cout << "ManCPP destroy" << endl; } char * ManCPP::get_name() { return this->name; } int ManCPP::get_age() { return this->age; } void ManCPP::set_name(char *name) { this->name = name; } void ManCPP::set_age(int age) { this->age = age; } MODULE = ManCPP PACKAGE = ManCPP PROTOTYPES: ENABLE ManCPP * ManCPP::new(char *name, int age) void ManCPP::DESTROY() char * ManCPP::get_name() int ManCPP::get_age() void ManCPP::set_name(char *name) void ManCPP::set_age(int age)
typemapも必要
TYPEMAP ManCPP * O_OBJECT INPUT O_OBJECT if( sv_isobject($arg) && (SvTYPE(SvRV($arg)) == SVt_PVMG) ) { $var = ($type)SvIV((SV*)SvRV( $arg )); } else { warn( \"${Package}::$func_name() -- $var is not a blessed SV reference\" ); XSRETURN_UNDEF; } OUTPUT O_OBJECT sv_setref_pv($arg, CLASS, (void *)$var);
threadを意識するような場合はしておくべきらしい。https://github.com/holly/perl-Proc-Wait4/blob/mast... は対応してみた
最新コメント