#include #include #include #include #define FILE_PERL "./perl_tk.pl" static PerlInterpreter *my_perl; static void xs_init _((void)); EXTERN_C void xs_init (pTHX); static int export_stack(double *tab, int i, char *str) { int j = 0; int result; dSP; /* initialise le pointeur de pile */ ENTER; /* tout ce qui est cree a partir d'ici */ SAVETMPS; /* ... est une variable temporaire */ PUSHMARK(SP); /* sauvegarde du pointeur de pile */ XPUSHs(sv_2mortal(newSVpvf("%s", str))); /* depose la base dans la pile */ for (j = 0; j < i; j++) { XPUSHs(sv_2mortal(newSVnv(tab[j]))); /* depose la base dans la pile */ } PUTBACK; /* rend global le pointeur local de pile */ perl_call_pv("import", G_SCALAR); /* appelle la fonction */ SPAGAIN; /* rafraichit le pointeur de pile */ result = POPi; PUTBACK; FREETMPS; /* libere la valeur de retour */ LEAVE; /* ...et retire les arguments empiles */ return result; } int export_p (double *tab, int len, char *req) { char *my_argv[] = { "", FILE_PERL }; int res; my_perl = perl_alloc(); perl_construct( my_perl ); perl_parse(my_perl, (void (*)(PerlInterpreter*))xs_init, 2, my_argv, (char **)NULL); perl_run(my_perl); res = export_stack(tab, len, req); // perl_destruct(my_perl); perl_free(my_perl); return res; }