Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Newer
Older
100644 147 lines (113 sloc) 2.627 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 */
5e23fcd @pmurias Flush all the filehandles when "destroying" the p5 interpreter.
pmurias authored
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 */
5e23fcd @pmurias Flush all the filehandles when "destroying" the p5 interpreter.
pmurias authored
48 PerlIO_flush(NULL);
1e1a24e @pmurias Eval runs basic perl5 code. The Makefile needs review to check if it can
pmurias authored
49 }
4266b44 @pmurias Argumentless method call on perl5 objects.
pmurias authored
50
51
2e3e4ba @pmurias Perl 5 methods can return a value.
pmurias authored
52 SV* p5method_call(char* name,SV** args,int args_count) {
53 dSP;
4266b44 @pmurias Argumentless method call on perl5 objects.
pmurias authored
54
55
56 PUSHMARK(SP);
a20956d @pmurias Arguments are passed to perl 5 methods.
pmurias authored
57 int i;
2e3e4ba @pmurias Perl 5 methods can return a value.
pmurias authored
58 for (i=0;i<args_count;i++) {
a20956d @pmurias Arguments are passed to perl 5 methods.
pmurias authored
59 XPUSHs(args[i]);
60 }
4266b44 @pmurias Argumentless method call on perl5 objects.
pmurias authored
61 PUTBACK;
62
2e3e4ba @pmurias Perl 5 methods can return a value.
pmurias authored
63
64 int count = call_method(name,G_SCALAR);
65 SPAGAIN;
66 if (count != 1) croak("Big trouble\n");
67
68 SV* ret = POPs;
69
70 /* TODO should i do that? */
71 SvREFCNT_inc(ret);
72
73 PUTBACK;
74
75 return ret;
4266b44 @pmurias Argumentless method call on perl5 objects.
pmurias authored
76
935bc30 @pmurias Perl 5 code refs are invokable.
pmurias authored
77 }
78
bf0cd86 @pmurias implement S01-perl-5-integration/context.t
pmurias authored
79 SV* p5embed_subcall(int context,SV** args,int args_count) {
935bc30 @pmurias Perl 5 code refs are invokable.
pmurias authored
80 dSP;
81
82
83 PUSHMARK(SP);
84 int i;
85 for (i=1;i<args_count;i++) {
86 XPUSHs(args[i]);
87 }
88 PUTBACK;
89
90
bf0cd86 @pmurias implement S01-perl-5-integration/context.t
pmurias authored
91 /* HACK - list context is NYI */
92 if (context == 1 || context == 0) {
0ae0fa0 @pmurias Enable specifing list context to p5 subs (we still support only one retu...
pmurias authored
93 int count = call_sv(args[0],context == 1 ? G_SCALAR : G_ARRAY);
bf0cd86 @pmurias implement S01-perl-5-integration/context.t
pmurias authored
94 SPAGAIN;
0ae0fa0 @pmurias Enable specifing list context to p5 subs (we still support only one retu...
pmurias authored
95 if (count != 1) croak("We do not support returning multiple return values yet.\n");
935bc30 @pmurias Perl 5 code refs are invokable.
pmurias authored
96
bf0cd86 @pmurias implement S01-perl-5-integration/context.t
pmurias authored
97 SV* ret = POPs;
935bc30 @pmurias Perl 5 code refs are invokable.
pmurias authored
98
bf0cd86 @pmurias implement S01-perl-5-integration/context.t
pmurias authored
99 /* TODO should i do that? */
100 SvREFCNT_inc(ret);
935bc30 @pmurias Perl 5 code refs are invokable.
pmurias authored
101
bf0cd86 @pmurias implement S01-perl-5-integration/context.t
pmurias authored
102 PUTBACK;
103 return ret;
104 } else if (context == 2) {
105 call_sv(args[0],G_VOID);
106 }
935bc30 @pmurias Perl 5 code refs are invokable.
pmurias authored
107
4266b44 @pmurias Argumentless method call on perl5 objects.
pmurias authored
108 }
18b719f @pmurias Perl5 integers are converted rather than wrapped.
pmurias authored
109
110 int p5embed_SvIOKp(SV* sv) {
111 return SvIOKp(sv);
112 }
113 int p5embed_SvNOKp(SV* sv) {
114 return SvNOKp(sv);
115 }
116 int p5embed_SvPOKp(SV* sv) {
117 return SvPOKp(sv);
118 }
119
120 int p5embed_SvIV(SV* sv) {
121 return SvIV(sv);
122 }
f20f832 @pmurias Perl5 NV values are converted.
pmurias authored
123 double p5embed_SvNV(SV* sv) {
124 return SvNV(sv);
125 }
c43c708 @pmurias Convert perl 5 string in an extremely naive fashion ignoring utf and nul...
pmurias authored
126 char* p5embed_SvPV_nolen(SV* sv) {
127 return SvPV_nolen(sv);
128 }
bfb4205 @pmurias Sending string with nulls in the middle from p5 land works.
pmurias authored
129
130 char* p5embed_SvPVutf8_nolen(SV* sv) {
131 return SvPVutf8_nolen(sv);
132 }
133
134 int p5embed_SvPVutf8_length(SV* sv) {
135 int length;
136 SvPVutf8(sv,length);
137 return length;
138 }
139
e1988ad @pmurias Perl 6 string can be converted to Perl 5 strings.
pmurias authored
140 SV* p5embed_newSVpvn(char* str,int len) {
141 return newSVpvn(str,len);
142 }
fb15db4 @pmurias Passing string with null bytes and unicode to perl5 land correctly.
pmurias authored
143
144 void p5embed_SvUTF8_on(SV* sv) {
145 SvUTF8_on(sv);
146 }
Something went wrong with that request. Please try again.