EXTERN_C PerlInterpreter * perl_clone_host(PerlInterpreter* proto_perl, UV flags) { dTHX; CPerlHost *h; h = new CPerlHost(*(CPerlHost*)PL_sys_intern.internal_host); proto_perl = perl_clone_using(proto_perl, flags, h->m_pHostperlMem, h->m_pHostperlMemShared, h->m_pHostperlMemParse, h->m_pHostperlEnv, h->m_pHostperlStdIO, h->m_pHostperlLIO, h->m_pHostperlDir, h->m_pHostperlSock, h->m_pHostperlProc ); proto_perl->Isys_intern.internal_host = h; h->host_perl = proto_perl; return proto_perl; }
EXTERN_C int RunPerl(int argc, char **argv, char **env) { int exitstatus = 0; ClsPerlHost nlm; PerlInterpreter *my_perl = NULL; // defined in Perl.h PerlInterpreter *new_perl = NULL; // defined in Perl.h //__asm{int 3}; #ifdef PERL_GLOBAL_STRUCT #define PERLVAR(prefix,var,type) #define PERLVARA(prefix,var,type) #define PERLVARI(prefix,var,type,init) PL_Vars.prefix##var = init; #define PERLVARIC(prefix,var,type,init) PL_Vars.prefix##var = init; #include "perlvars.h" #undef PERLVAR #undef PERLVARA #undef PERLVARI #undef PERLVARIC #endif PERL_SYS_INIT(&argc, &argv); if (!(my_perl = perl_alloc())) // Allocate memory for Perl. return (1); if(nlm.PerlCreate(my_perl)) { PL_perl_destruct_level = 0; if(!nlm.PerlParse(my_perl, argc, argv, env)) { #if defined(TOP_CLONE) && defined(USE_ITHREADS) // XXXXXX testing # ifdef PERL_OBJECT CPerlHost *h = new CPerlHost(); new_perl = perl_clone_using(my_perl, 1, h->m_pHostperlMem, h->m_pHostperlMemShared, h->m_pHostperlMemParse, h->m_pHostperlEnv, h->m_pHostperlStdIO, h->m_pHostperlLIO, h->m_pHostperlDir, h->m_pHostperlSock, h->m_pHostperlProc ); CPerlObj *pPerl = (CPerlObj*)new_perl; # else new_perl = perl_clone(my_perl, 1); # endif (void) perl_run(new_perl); // Run Perl. PERL_SET_THX(my_perl); #else (void) nlm.PerlRun(my_perl); #endif } exitstatus = nlm.PerlDestroy(my_perl); } if(my_perl) nlm.PerlFree(my_perl); #ifdef USE_ITHREADS if (new_perl) { PERL_SET_THX(new_perl); exitstatus = nlm.PerlDestroy(new_perl); nlm.PerlFree(my_perl); } #endif PERL_SYS_TERM(); return exitstatus; }