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 | |
57dea26d |
11 | #ifndef EXTERN_C |
12 | # ifdef __cplusplus |
13 | # define EXTERN_C extern "C" |
14 | # else |
15 | # define EXTERN_C extern |
16 | # endif |
d50cb536 |
17 | #endif |
18 | |
20ce7b12 |
19 | static void xs_init (void); |
d50cb536 |
20 | static PerlInterpreter *my_perl; |
21 | |
22 | int jpldebug = 0; |
23 | JNIEnv *jplcurenv; |
24 | |
25 | JNIEXPORT void JNICALL |
26 | Java_PerlInterpreter_init(JNIEnv *env, jobject obj, jstring js) |
27 | { |
28 | int exitstatus; |
29 | int argc = 3; |
30 | SV* envsv; |
31 | SV* objsv; |
32 | |
33 | static char *argv[] = {"perl", "-e", "1", 0}; |
34 | |
35 | if (getenv("JPLDEBUG")) |
36 | jpldebug = atoi(getenv("JPLDEBUG")); |
37 | |
38 | if (jpldebug) |
39 | fprintf(stderr, "init\n"); |
40 | |
41 | if (!dlopen("libperl.so", RTLD_LAZY|RTLD_GLOBAL)) { |
42 | fprintf(stderr, "%s\n", dlerror()); |
43 | exit(1); |
44 | } |
45 | |
57dea26d |
46 | if (PL_curinterp) |
d50cb536 |
47 | return; |
48 | |
49 | perl_init_i18nl10n(1); |
50 | |
57dea26d |
51 | if (!PL_do_undump) { |
d50cb536 |
52 | my_perl = perl_alloc(); |
53 | if (!my_perl) |
54 | exit(1); |
55 | perl_construct( my_perl ); |
57dea26d |
56 | PL_perl_destruct_level = 0; |
d50cb536 |
57 | } |
58 | |
59 | exitstatus = perl_parse( my_perl, xs_init, argc, argv, (char **) NULL ); |
60 | |
61 | if (!exitstatus) |
62 | Java_PerlInterpreter_eval(env, obj, js); |
63 | |
64 | } |
65 | |
66 | JNIEXPORT void JNICALL |
67 | Java_PerlInterpreter_eval(JNIEnv *env, jobject obj, jstring js) |
68 | { |
69 | SV* envsv; |
70 | SV* objsv; |
71 | dSP; |
72 | jbyte* jb; |
73 | |
74 | ENTER; |
75 | SAVETMPS; |
76 | |
77 | jplcurenv = env; |
78 | envsv = perl_get_sv("JPL::_env_", 1); |
79 | sv_setiv(envsv, (IV)(void*)env); |
80 | objsv = perl_get_sv("JPL::_obj_", 1); |
81 | sv_setiv(objsv, (IV)(void*)obj); |
82 | |
83 | jb = (jbyte*)(*env)->GetStringUTFChars(env,js,0); |
84 | |
85 | if (jpldebug) |
86 | fprintf(stderr, "eval %s\n", (char*)jb); |
87 | |
88 | perl_eval_pv( (char*)jb, 0 ); |
89 | |
57dea26d |
90 | if (SvTRUE(ERRSV)) { |
d50cb536 |
91 | jthrowable newExcCls; |
92 | |
93 | (*env)->ExceptionDescribe(env); |
94 | (*env)->ExceptionClear(env); |
95 | |
96 | newExcCls = (*env)->FindClass(env, "java/lang/RuntimeException"); |
97 | if (newExcCls) |
57dea26d |
98 | (*env)->ThrowNew(env, newExcCls, SvPV(ERRSV,PL_na)); |
d50cb536 |
99 | } |
100 | |
101 | (*env)->ReleaseStringUTFChars(env,js,jb); |
102 | FREETMPS; |
103 | LEAVE; |
104 | |
105 | } |
106 | |
107 | /* |
108 | JNIEXPORT jint JNICALL |
109 | Java_PerlInterpreter_eval(JNIEnv *env, jobject obj, jint ji) |
110 | { |
111 | op = (OP*)(void*)ji; |
112 | op = (*op->op_ppaddr)(); |
113 | return (jint)(void*)op; |
114 | } |
115 | */ |
116 | |
117 | /* Register any extra external extensions */ |
118 | |
119 | /* Do not delete this line--writemain depends on it */ |
20ce7b12 |
120 | EXTERN_C void boot_DynaLoader (CV* cv); |
121 | EXTERN_C void boot_JNI (CV* cv); |
d50cb536 |
122 | |
123 | static void |
124 | xs_init() |
125 | { |
126 | char *file = __FILE__; |
127 | dXSUB_SYS; |
128 | newXS("DynaLoader::boot_DynaLoader", boot_DynaLoader, file); |
129 | } |