Commit | Line | Data |
d50cb536 |
1 | /* |
2 | * "The Road goes ever on and on, down from the door where it began." |
3 | */ |
4 | |
5 | #include "PerlInterpreter.h" |
6 | #include <dlfcn.h> |
7 | |
d50cb536 |
8 | #include "EXTERN.h" |
9 | #include "perl.h" |
10 | |
b83c0eaa |
11 | #ifndef PERL_VERSION |
12 | # include <patchlevel.h> |
13 | # define PERL_REVISION 5 |
14 | # define PERL_VERSION PATCHLEVEL |
15 | # define PERL_SUBVERSION SUBVERSION |
16 | #endif |
17 | |
18 | #if PERL_REVISION == 5 && (PERL_VERSION < 4 || \ |
19 | (PERL_VERSION == 4 && PERL_SUBVERSION <= 75)) |
20 | # define PL_na na |
21 | # define PL_sv_no sv_no |
22 | # define PL_sv_undef sv_undef |
23 | # define PL_dowarn dowarn |
24 | # define PL_curinterp curinterp |
25 | # define PL_do_undump do_undump |
26 | # define PL_perl_destruct_level perl_destruct_level |
27 | # define ERRSV GvSV(errgv) |
28 | #endif |
29 | |
30 | #ifndef newSVpvn |
31 | # define newSVpvn(a,b) newSVpv(a,b) |
32 | #endif |
33 | |
34 | #ifndef pTHX |
35 | # define pTHX void |
36 | # define pTHX_ |
37 | # define aTHX |
38 | # define aTHX_ |
39 | # define dTHX extern int JNI___notused |
40 | #endif |
41 | |
57dea26d |
42 | #ifndef EXTERN_C |
43 | # ifdef __cplusplus |
44 | # define EXTERN_C extern "C" |
45 | # else |
46 | # define EXTERN_C extern |
47 | # endif |
d50cb536 |
48 | #endif |
49 | |
41cd3736 |
50 | static void xs_init (pTHX); |
d50cb536 |
51 | static PerlInterpreter *my_perl; |
52 | |
53 | int jpldebug = 0; |
54 | JNIEnv *jplcurenv; |
55 | |
56 | JNIEXPORT void JNICALL |
57 | Java_PerlInterpreter_init(JNIEnv *env, jobject obj, jstring js) |
58 | { |
59 | int exitstatus; |
60 | int argc = 3; |
61 | SV* envsv; |
62 | SV* objsv; |
63 | |
64 | static char *argv[] = {"perl", "-e", "1", 0}; |
65 | |
66 | if (getenv("JPLDEBUG")) |
67 | jpldebug = atoi(getenv("JPLDEBUG")); |
68 | |
69 | if (jpldebug) |
70 | fprintf(stderr, "init\n"); |
71 | |
72 | if (!dlopen("libperl.so", RTLD_LAZY|RTLD_GLOBAL)) { |
73 | fprintf(stderr, "%s\n", dlerror()); |
74 | exit(1); |
75 | } |
76 | |
57dea26d |
77 | if (PL_curinterp) |
d50cb536 |
78 | return; |
79 | |
b83c0eaa |
80 | perl_init_i18nl10n(1); |
81 | |
57dea26d |
82 | if (!PL_do_undump) { |
d50cb536 |
83 | my_perl = perl_alloc(); |
84 | if (!my_perl) |
85 | exit(1); |
86 | perl_construct( my_perl ); |
57dea26d |
87 | PL_perl_destruct_level = 0; |
d50cb536 |
88 | } |
89 | |
90 | exitstatus = perl_parse( my_perl, xs_init, argc, argv, (char **) NULL ); |
91 | |
92 | if (!exitstatus) |
93 | Java_PerlInterpreter_eval(env, obj, js); |
94 | |
95 | } |
96 | |
97 | JNIEXPORT void JNICALL |
b83c0eaa |
98 | Java_PerlInterpreter_eval(JNIEnv *env, jobject obj, jstring js) |
d50cb536 |
99 | { |
100 | SV* envsv; |
101 | SV* objsv; |
102 | dSP; |
103 | jbyte* jb; |
104 | |
105 | ENTER; |
106 | SAVETMPS; |
107 | |
108 | jplcurenv = env; |
b83c0eaa |
109 | envsv = perl_get_sv("JPL::_env_", 1); |
d50cb536 |
110 | sv_setiv(envsv, (IV)(void*)env); |
b83c0eaa |
111 | objsv = perl_get_sv("JPL::_obj_", 1); |
d50cb536 |
112 | sv_setiv(objsv, (IV)(void*)obj); |
113 | |
114 | jb = (jbyte*)(*env)->GetStringUTFChars(env,js,0); |
115 | |
116 | if (jpldebug) |
117 | fprintf(stderr, "eval %s\n", (char*)jb); |
118 | |
b83c0eaa |
119 | perl_eval_pv( (char*)jb, 0 ); |
d50cb536 |
120 | |
57dea26d |
121 | if (SvTRUE(ERRSV)) { |
d50cb536 |
122 | jthrowable newExcCls; |
123 | |
124 | (*env)->ExceptionDescribe(env); |
125 | (*env)->ExceptionClear(env); |
126 | |
127 | newExcCls = (*env)->FindClass(env, "java/lang/RuntimeException"); |
128 | if (newExcCls) |
57dea26d |
129 | (*env)->ThrowNew(env, newExcCls, SvPV(ERRSV,PL_na)); |
d50cb536 |
130 | } |
131 | |
132 | (*env)->ReleaseStringUTFChars(env,js,jb); |
133 | FREETMPS; |
134 | LEAVE; |
135 | |
136 | } |
137 | |
138 | /* |
139 | JNIEXPORT jint JNICALL |
b83c0eaa |
140 | Java_PerlInterpreter_eval(JNIEnv *env, jobject obj, jint ji) |
d50cb536 |
141 | { |
142 | op = (OP*)(void*)ji; |
41cd3736 |
143 | op = (*op->op_ppaddr)(pTHX); |
d50cb536 |
144 | return (jint)(void*)op; |
145 | } |
146 | */ |
147 | |
148 | /* Register any extra external extensions */ |
149 | |
150 | /* Do not delete this line--writemain depends on it */ |
41cd3736 |
151 | EXTERN_C void boot_DynaLoader (pTHX_ CV* cv); |
152 | EXTERN_C void boot_JNI (pTHX_ CV* cv); |
d50cb536 |
153 | |
154 | static void |
41cd3736 |
155 | xs_init(pTHX) |
d50cb536 |
156 | { |
157 | char *file = __FILE__; |
158 | dXSUB_SYS; |
159 | newXS("DynaLoader::boot_DynaLoader", boot_DynaLoader, file); |
160 | } |