Example #1
0
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;
	
}
Example #2
0
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;
}