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

/*
 * "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 (pTHX);
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;

    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(void *perl, JNIEnv *env, jobject obj, jstring js)
{
    SV* envsv;
    SV* objsv;
    dSP;
    jbyte* jb;
    dTHXa(perl);

    ENTER;
    SAVETMPS;

    jplcurenv = env;
    envsv = get_sv("JPL::_env_", 1);
    sv_setiv(envsv, (IV)(void*)env);
    objsv = 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);

    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(void *perl, JNIEnv *env, jobject obj, jint ji)
{
    dTHXa(perl);
    op = (OP*)(void*)ji;
    op = (*op->op_ppaddr)(pTHX);
    return (jint)(void*)op;
}
*/

/* Register any extra external extensions */

/* Do not delete this line--writemain depends on it */
EXTERN_C void boot_DynaLoader (pTHX_ CV* cv);
EXTERN_C void boot_JNI (pTHX_ CV* cv);

static void
xs_init(pTHX)
{
    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
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
d50cb536	18
41cd3736	19	static void xs_init (pTHX);
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;
d50cb536	48
57dea26d	49	if (!PL_do_undump) {
d50cb536	50	my_perl = perl_alloc();
	51	if (!my_perl)
	52	exit(1);
	53	perl_construct( my_perl );
57dea26d	54	PL_perl_destruct_level = 0;
d50cb536	55	}
	56
	57	exitstatus = perl_parse( my_perl, xs_init, argc, argv, (char **) NULL );
	58
	59	if (!exitstatus)
	60	Java_PerlInterpreter_eval(env, obj, js);
	61
	62	}
	63
	64	JNIEXPORT void JNICALL
41cd3736	65	Java_PerlInterpreter_eval(void perl, JNIEnv env, jobject obj, jstring js)
d50cb536	66	{
	67	SV* envsv;
	68	SV* objsv;
	69	dSP;
	70	jbyte* jb;
41cd3736	71	dTHXa(perl);
d50cb536	72
	73	ENTER;
	74	SAVETMPS;
	75
	76	jplcurenv = env;
41cd3736	77	envsv = get_sv("JPL::_env_", 1);
d50cb536	78	sv_setiv(envsv, (IV)(void*)env);
41cd3736	79	objsv = get_sv("JPL::_obj_", 1);
d50cb536	80	sv_setiv(objsv, (IV)(void*)obj);
	81
	82	jb = (jbyte)(env)->GetStringUTFChars(env,js,0);
	83
	84	if (jpldebug)
	85	fprintf(stderr, "eval %s\n", (char*)jb);
	86
41cd3736	87	eval_pv( (char*)jb, 0 );
d50cb536	88
57dea26d	89	if (SvTRUE(ERRSV)) {
d50cb536	90	jthrowable newExcCls;
	91
	92	(*env)->ExceptionDescribe(env);
	93	(*env)->ExceptionClear(env);
	94
	95	newExcCls = (*env)->FindClass(env, "java/lang/RuntimeException");
	96	if (newExcCls)
57dea26d	97	(*env)->ThrowNew(env, newExcCls, SvPV(ERRSV,PL_na));
d50cb536	98	}
	99
	100	(*env)->ReleaseStringUTFChars(env,js,jb);
	101	FREETMPS;
	102	LEAVE;
	103
	104	}
	105
	106	/*
	107	JNIEXPORT jint JNICALL
41cd3736	108	Java_PerlInterpreter_eval(void perl, JNIEnv env, jobject obj, jint ji)
d50cb536	109	{
41cd3736	110	dTHXa(perl);
d50cb536	111	op = (OP)(void)ji;
41cd3736	112	op = (*op->op_ppaddr)(pTHX);
d50cb536	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 */
41cd3736	120	EXTERN_C void boot_DynaLoader (pTHX_ CV* cv);
41cd3736	121	EXTERN_C void boot_JNI (pTHX_ CV* cv);
d50cb536	122
d50cb536	123	static void
41cd3736	124	xs_init(pTHX)
d50cb536	125	{
	126	char *file = __FILE__;
	127	dXSUB_SYS;
	128	newXS("DynaLoader::boot_DynaLoader", boot_DynaLoader, file);
	129	}