Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Newer
Older
100644 131 lines (101 sloc) 2.307 kB
1e1a24e @pmurias Eval runs basic perl5 code. The Makefile needs review to check if it can
pmurias authored
1 #include <EXTERN.h>
2 #include <perl.h>
3
4 /* So that we can load XS using modules from our perl */
5 EXTERN_C void xs_init (pTHX);
6
7 EXTERN_C void boot_DynaLoader (pTHX_ CV* cv);
8
9 EXTERN_C void
10 xs_init(pTHX)
11 {
12 char *file = __FILE__;
13 dXSUB_SYS;
14
15 /* DynaLoader is a special case */
16 newXS("DynaLoader::boot_DynaLoader", boot_DynaLoader, file);
17 }
18
19 static PerlInterpreter *my_perl;
20 void p5embed_initialize()
21 {
d468f8f @sorear Pass non-null argc,argv to PERL_SYS_INIT
authored
22 int argc = 1;
23 char *argv0[] = { "perl", NULL, 0 };
24 char **argv = argv0;
25 PERL_SYS_INIT(&argc,&argv);
fd1e6d8 @pmurias fix segfault when eval perl5 code using a threaded perl
pmurias authored
26 my_perl = perl_alloc();
1e1a24e @pmurias Eval runs basic perl5 code. The Makefile needs review to check if it can
pmurias authored
27 perl_construct(my_perl);
28 char *embedding[] = { "", "-e", "0" };
29 perl_parse(my_perl, xs_init, 3, embedding, NULL);
30 PL_exit_flags |= PERL_EXIT_DESTRUCT_END;
bf4e20a @pmurias remove suspect PERL_SET_CONTEXT
pmurias authored
31 // eval_pv("use lib 'perl5';use Niecza::Interoperability",TRUE);
1e1a24e @pmurias Eval runs basic perl5 code. The Makefile needs review to check if it can
pmurias authored
32 }
33
4266b44 @pmurias Argumentless method call on perl5 objects.
pmurias authored
34 SV* p5embed_eval(char* code) {
bf4e20a @pmurias remove suspect PERL_SET_CONTEXT
pmurias authored
35 eval_pv("1",TRUE);
ee9b534 @pmurias Add debugging statements to p5 eval.
pmurias authored
36 SV* ret = eval_pv(code,TRUE);
37 return ret;
1e1a24e @pmurias Eval runs basic perl5 code. The Makefile needs review to check if it can
pmurias authored
38 }
39
40 void p5embed_dispose()
41 {
5ff062b @pmurias Disable the destruction of the interpreter as it segfaults.
pmurias authored
42 /* Disable temorarly as it seems to cause segfaults */
43 /*
16ef0c8 @pmurias cleanup the perl5 interpreter in Perl5Interpreter destructor
pmurias authored
44 perl_destruct(my_perl);
45 perl_free(my_perl);
46 PERL_SYS_TERM();
5ff062b @pmurias Disable the destruction of the interpreter as it segfaults.
pmurias authored
47 */
1e1a24e @pmurias Eval runs basic perl5 code. The Makefile needs review to check if it can
pmurias authored
48 }
4266b44 @pmurias Argumentless method call on perl5 objects.
pmurias authored
49
50
2e3e4ba @pmurias Perl 5 methods can return a value.
pmurias authored
51 SV* p5method_call(char* name,SV** args,int args_count) {
52 dSP;
4266b44 @pmurias Argumentless method call on perl5 objects.
pmurias authored
53
54
55 PUSHMARK(SP);
a20956d @pmurias Arguments are passed to perl 5 methods.
pmurias authored
56 int i;
2e3e4ba @pmurias Perl 5 methods can return a value.
pmurias authored
57 for (i=0;i<args_count;i++) {
a20956d @pmurias Arguments are passed to perl 5 methods.
pmurias authored
58 XPUSHs(args[i]);
59 }
4266b44 @pmurias Argumentless method call on perl5 objects.
pmurias authored
60 PUTBACK;
61
2e3e4ba @pmurias Perl 5 methods can return a value.
pmurias authored
62
63 int count = call_method(name,G_SCALAR);
64 SPAGAIN;
65 if (count != 1) croak("Big trouble\n");
66
67 SV* ret = POPs;
68
69 /* TODO should i do that? */
70 SvREFCNT_inc(ret);
71
72 PUTBACK;
73
74 return ret;
4266b44 @pmurias Argumentless method call on perl5 objects.
pmurias authored
75
935bc30 @pmurias Perl 5 code refs are invokable.
pmurias authored
76 }
77
bf0cd86 @pmurias implement S01-perl-5-integration/context.t
pmurias authored
78 SV* p5embed_subcall(int context,SV** args,int args_count) {
935bc30 @pmurias Perl 5 code refs are invokable.
pmurias authored
79 dSP;
80
81
82 PUSHMARK(SP);
83 int i;
84 for (i=1;i<args_count;i++) {
85 XPUSHs(args[i]);
86 }
87 PUTBACK;
88
89
bf0cd86 @pmurias implement S01-perl-5-integration/context.t
pmurias authored
90 /* HACK - list context is NYI */
91 if (context == 1 || context == 0) {
92 int count = call_sv(args[0],G_SCALAR);
93 SPAGAIN;
94 if (count != 1) croak("Big trouble\n");
935bc30 @pmurias Perl 5 code refs are invokable.
pmurias authored
95
bf0cd86 @pmurias implement S01-perl-5-integration/context.t
pmurias authored
96 SV* ret = POPs;
935bc30 @pmurias Perl 5 code refs are invokable.
pmurias authored
97
bf0cd86 @pmurias implement S01-perl-5-integration/context.t
pmurias authored
98 /* TODO should i do that? */
99 SvREFCNT_inc(ret);
935bc30 @pmurias Perl 5 code refs are invokable.
pmurias authored
100
bf0cd86 @pmurias implement S01-perl-5-integration/context.t
pmurias authored
101 PUTBACK;
102 return ret;
103 } else if (context == 2) {
104 call_sv(args[0],G_VOID);
105 }
935bc30 @pmurias Perl 5 code refs are invokable.
pmurias authored
106
4266b44 @pmurias Argumentless method call on perl5 objects.
pmurias authored
107 }
18b719f @pmurias Perl5 integers are converted rather than wrapped.
pmurias authored
108
109 int p5embed_SvIOKp(SV* sv) {
110 return SvIOKp(sv);
111 }
112 int p5embed_SvNOKp(SV* sv) {
113 return SvNOKp(sv);
114 }
115 int p5embed_SvPOKp(SV* sv) {
116 return SvPOKp(sv);
117 }
118
119 int p5embed_SvIV(SV* sv) {
120 return SvIV(sv);
121 }
f20f832 @pmurias Perl5 NV values are converted.
pmurias authored
122 double p5embed_SvNV(SV* sv) {
123 return SvNV(sv);
124 }
c43c708 @pmurias Convert perl 5 string in an extremely naive fashion ignoring utf and …
pmurias authored
125 char* p5embed_SvPV_nolen(SV* sv) {
126 return SvPV_nolen(sv);
127 }
e1988ad @pmurias Perl 6 string can be converted to Perl 5 strings.
pmurias authored
128 SV* p5embed_newSVpvn(char* str,int len) {
129 return newSVpvn(str,len);
130 }
Something went wrong with that request. Please try again.