hollyさんのwiki

もう忘れてしまってるのでよくわからん

参考になりそうなところ

変数の型

  • SV スカラー
  • AV 配列
  • HV ハッシュ
  • CV コード
  • GV グロブ
  • RV リファレンス
  • IV 整数
  • NV 実数
  • PV 文字列

C++なxsを作ってみる

h2xs

せっかくなのでC++にしたい場合。まずはいつものh2xs
h2xs -A -n CPPXS
Makefile.PLを編集
# WriteMakefileの引数に追加
CC => "g++",
LD => "g++",
CPPXSディレクトリに移動してMakefile.PLを編集し、実行
perl Makefile.PL
CPPXS.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 + xs

たぶんどっちかっていうとこっちが主流?
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というパッケージを作る。初めは丁寧にやってみる
h2xs -A -n PrintXS
PrintXSディレクトリの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/null
PerlIO_printfの第2引数に渡す変数はCのchar*型でないとだめなので、SV*とかの場合は
SvPVX(SV*)
のようにして被参照を行うといいらしい。

true or false

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";
}

xsからpackage変数を参照したい場合

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 とか参考になる

blessされたリファレンスのpackage名を取得する

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を使って、リストを返す
#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) )));
とすると速度がはやくなるようだ

perlのundef返す

&PL_sv_undefを使う。(&sv_undefでもいいみたい。XSRETURN_UNDEFでもいいような気がする)。
2010/9/30追加。newSV(0)らしい。NULL 型の空の SV を返す。ということだそうな。

ARRAYリファレンス

ARRAYリファレンスを返す
※ここからC++で。相変わらずあまりわかってないけど
#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'
       ];
として結果が得られるはず。

HASHリファレンス

HASHリファレンスを返す
ほとんど配列の時と変わらない
#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
XSの中でCODEリファレンスを実行
#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" });
とすればよい
XSの中でCODEリファレンスから返り値を受け取る
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 整数
http://www.namazu.org/~tsuchiya/perl/info/perl-ja_...を見真似すると
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 { "あいうえお", "かきくけこ" });
XSの中でCODEリファレンスに引数を渡す
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引数の合計値が出力される。

new

newをxsで実装する
#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
と出力される
c++のクラスをperlの世界にmapping
とでもいえばいいのか
#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);

PERL_NO_GET_CONTEXT

threadを意識するような場合はしておくべきらしい。https://github.com/holly/perl-Proc-Wait4/blob/mast... は対応してみた
×

この広告は60日間更新がないwikiに表示されております。

Wiki内検索

Menu

ここは自由に編集できるエリアです。

管理人のみ編集できます