[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 PERL_VERSION
#  include <patchlevel.h>
#  define PERL_REVISION		5
#  define PERL_VERSION		PATCHLEVEL
#  define PERL_SUBVERSION	SUBVERSION
#endif

#if PERL_REVISION == 5 && (PERL_VERSION < 4 || \
			   (PERL_VERSION == 4 && PERL_SUBVERSION <= 75))
#  define PL_na				na
#  define PL_sv_no			sv_no
#  define PL_sv_undef			sv_undef
#  define PL_dowarn			dowarn
#  define PL_curinterp			curinterp
#  define PL_do_undump			do_undump
#  define PL_perl_destruct_level	perl_destruct_level
#  define ERRSV				GvSV(errgv)
#endif

#ifndef newSVpvn
#  define newSVpvn(a,b)	newSVpv(a,b)
#endif

#ifndef pTHX
#  define pTHX		void
#  define pTHX_
#  define aTHX
#  define aTHX_
#  define dTHX		extern int JNI___notused
#endif

#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;

    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)(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
c529f79d	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
d50cb536	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;
d50cb536	79
c529f79d	80	perl_init_i18nl10n(1);
c529f79d	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
c529f79d	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;
c529f79d	109	envsv = perl_get_sv("JPL::_env_", 1);
d50cb536	110	sv_setiv(envsv, (IV)(void*)env);
c529f79d	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
c529f79d	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
c529f79d	140	Java_PerlInterpreter_eval(JNIEnv *env, jobject obj, jint ji)
d50cb536	141	{
d50cb536	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);
41cd3736	152	EXTERN_C void boot_JNI (pTHX_ CV* cv);
d50cb536	153
d50cb536	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	}