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