[p5sagit/p5-mst-13.2.git] / PerlInterpreter / PerlInterpreter.c

/*
 * "The Road goes ever on and on, down from the door where it began."
 */

#include "PerlInterpreter.h"
#include <dlfcn.h>

#ifdef __cplusplus
extern "C" {
#endif

#include "EXTERN.h"
#include "perl.h"

#ifdef __cplusplus
}
#  define EXTERN_C extern "C"
#else
#  define EXTERN_C extern
#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 (curinterp)
	return;

    perl_init_i18nl10n(1);

    if (!do_undump) {
	my_perl = perl_alloc();
	if (!my_perl)
	    exit(1);
	perl_construct( my_perl );
	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(GvSV(errgv))) {
	jthrowable newExcCls;

	(*env)->ExceptionDescribe(env);
	(*env)->ExceptionClear(env);

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