home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / perl560.zip / jpl / PerlInterpreter / PerlInterpreter.c < prev    next >
C/C++ Source or Header  |  1999-09-14  |  3KB  |  161 lines
  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. #include "EXTERN.h"
  9. #include "perl.h"
  10.  
  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.  
  42. #ifndef EXTERN_C
  43. #  ifdef __cplusplus
  44. #    define EXTERN_C extern "C"
  45. #  else
  46. #    define EXTERN_C extern
  47. #  endif
  48. #endif
  49.  
  50. static void xs_init (pTHX);
  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.  
  77.     if (PL_curinterp)
  78.     return;
  79.  
  80.     perl_init_i18nl10n(1);
  81.  
  82.     if (!PL_do_undump) {
  83.     my_perl = perl_alloc();
  84.     if (!my_perl)
  85.         exit(1);
  86.     perl_construct( my_perl );
  87.     PL_perl_destruct_level = 0;
  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
  98. Java_PerlInterpreter_eval(JNIEnv *env, jobject obj, jstring js)
  99. {
  100.     SV* envsv;
  101.     SV* objsv;
  102.     dSP;
  103.     jbyte* jb;
  104.  
  105.     ENTER;
  106.     SAVETMPS;
  107.  
  108.     jplcurenv = env;
  109.     envsv = perl_get_sv("JPL::_env_", 1);
  110.     sv_setiv(envsv, (IV)(void*)env);
  111.     objsv = perl_get_sv("JPL::_obj_", 1);
  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.  
  119.     perl_eval_pv( (char*)jb, 0 );
  120.  
  121.     if (SvTRUE(ERRSV)) {
  122.     jthrowable newExcCls;
  123.  
  124.     (*env)->ExceptionDescribe(env);
  125.     (*env)->ExceptionClear(env);
  126.  
  127.     newExcCls = (*env)->FindClass(env, "java/lang/RuntimeException");
  128.     if (newExcCls)
  129.         (*env)->ThrowNew(env, newExcCls, SvPV(ERRSV,PL_na));
  130.     }
  131.  
  132.     (*env)->ReleaseStringUTFChars(env,js,jb);
  133.     FREETMPS;
  134.     LEAVE;
  135.  
  136. }
  137.  
  138. /*
  139. JNIEXPORT jint JNICALL
  140. Java_PerlInterpreter_eval(JNIEnv *env, jobject obj, jint ji)
  141. {
  142.     op = (OP*)(void*)ji;
  143.     op = (*op->op_ppaddr)(pTHX);
  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 */
  151. EXTERN_C void boot_DynaLoader (pTHX_ CV* cv);
  152. EXTERN_C void boot_JNI (pTHX_ CV* cv);
  153.  
  154. static void
  155. xs_init(pTHX)
  156. {
  157.     char *file = __FILE__;
  158.     dXSUB_SYS;
  159.         newXS("DynaLoader::boot_DynaLoader", boot_DynaLoader, file);
  160. }
  161.