pike.git
/
src
/
modules
/
Perl
/
perlmod.c
version
»
Context lines:
10
20
40
80
file
none
3
pike.git/src/modules/Perl/perlmod.c:1:
-
/* $Id: perlmod.c,v 1.
23
2000
/12/
05
21
:
08
:
31
per
Exp $ */
+
/* $Id: perlmod.c,v 1.
24
2001
/12/
22
00
:
27
:
48
nilsson
Exp $ */
#define NO_PIKE_SHORTHAND #include "builtin_functions.h" #include "global.h" #include "svalue.h" #include "array.h" #include "stralloc.h" #include "interpret.h" #include "module_support.h"
pike.git/src/modules/Perl/perlmod.c:431:
i=perl_run(ps->perl); MT_FORBID; push_int(i); } static void _perlmod_eval(INT32 args, int perlflags) { struct pike_string *firstarg; struct perlmod_storage *ps = _THIS; int i, n;
-
/
/
#define sp _perlsp
+
/
*
#define sp _perlsp
*/
dSP; if (!ps->perl) Pike_error("Perl interpreter not available.\n"); check_all_args("Perl->eval", args, BIT_STRING, 0); firstarg = Pike_sp[-args].u.string; ENTER; SAVETMPS; PUSHMARK(sp); PUTBACK;
-
/
/
#undef sp
+
/
*
#undef sp
*/
if (!ps->parsed) { #if 0 _perl_parse(ps, 3, dummyargv, NULL); #else #ifndef MY_XS extern void xs_init(void); #endif perl_parse(ps->perl, xs_init, 3, dummyargv, NULL);
pike.git/src/modules/Perl/perlmod.c:470:
/* perl5.6.0 testing: newSVpv((const char *) "ABC", 3); */ n = perl_eval_sv(newSVpv((firstarg->str), (firstarg->len)), perlflags | G_EVAL); MT_FORBID; pop_n_elems(args);
-
/
/
#define sp _perlsp
+
/
*
#define sp _perlsp
*/
SPAGAIN; if (SvTRUE(GvSV(PL_errgv))) { char errtmp[256]; memset(errtmp, 0, sizeof(errtmp)); strcpy(errtmp, "Error from Perl: "); strncpy(errtmp+strlen(errtmp), SvPV(GvSV(PL_errgv), PL_na), 254-strlen(errtmp)); POPs;
pike.git/src/modules/Perl/perlmod.c:498:
_sv_to_svalue(POPs, &(a->item[(n-1)-i])); push_array(a); } else if (n > 0) { for(; n > 1; --n) POPs; _pikepush_sv(POPs); } else _push_zerotype(); PUTBACK; FREETMPS; LEAVE;
-
/
/
#undef sp
+
/
*
#undef sp
*/
} static void perlmod_eval(INT32 args) { _perlmod_eval(args, G_SCALAR); } static void perlmod_eval_list(INT32 args) { _perlmod_eval(args, G_ARRAY); } static void _perlmod_call(INT32 args, int perlflags) { struct perlmod_storage *ps = _THIS; int i, n; char *pv;
-
/
/
#define sp _perlsp
+
/
*
#define sp _perlsp
*/
dSP; #ifdef PIKE_PERLDEBUG fprintf(stderr, "[perlmod_call: args=%d]\n", args); #endif if (!ps->perl) Pike_error("No perl interpreter available.\n"); if (args < 1) Pike_error("Too few arguments.\n"); if (args > 201) Pike_error("Too many arguments.\n");
pike.git/src/modules/Perl/perlmod.c:566:
default: msg = "Unsupported argument type.\n"; PUTBACK; FREETMPS; LEAVE; Pike_error(msg); return; } } PUTBACK; pv = Pike_sp[-args].u.string->str;
-
/
/
#undef sp
+
/
*
#undef sp
*/
MT_PERMIT; n = perl_call_pv(pv, perlflags); MT_FORBID;
-
/
/
#define sp _perlsp
+
/
*
#define sp _perlsp
*/
pop_n_elems(args); SPAGAIN; if (SvTRUE(GvSV(PL_errgv))) { char errtmp[256]; memset(errtmp, 0, sizeof(errtmp)); strcpy(errtmp, "Error from Perl: "); strncpy(errtmp+strlen(errtmp),
pike.git/src/modules/Perl/perlmod.c:615:
for(i = 0; i < n; ++i) _sv_to_svalue(POPs, &(a->item[(n-1)-i])); push_array(a); } else if (n == 1) _pikepush_sv(POPs); else /* shouldn't happen unless we put G_DISCARD in perlflags */ _push_zerotype(); PUTBACK; FREETMPS; LEAVE;
-
/
/
#undef sp
+
/
*
#undef sp
*/
} static void perlmod_call_list(INT32 args) { _perlmod_call(args, G_ARRAY | G_EVAL); } static void perlmod_call(INT32 args) { _perlmod_call(args, G_SCALAR | G_EVAL); }