X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=win32%2Fperllib.c;h=6243a79fd3d4ea21dfdc6168db79de7924a3df44;hb=91af766ac8815630662ce7fde84b165de512e80f;hp=fcf1bec884d8c2ea381f5de35dc7e1d56edfa979;hpb=9613994f65a16945d058ed97125397c8b3381e8f;p=p5sagit%2Fp5-mst-13.2.git diff --git a/win32/perllib.c b/win32/perllib.c index fcf1bec..6243a79 100644 --- a/win32/perllib.c +++ b/win32/perllib.c @@ -5,10 +5,6 @@ #include "EXTERN.h" #include "perl.h" -#ifdef PERL_OBJECT -#define NO_XSLOCKS -#endif - #include "XSUB.h" #ifdef PERL_IMPLICIT_SYS @@ -23,10 +19,10 @@ char *staticlinkmodules[] = { NULL, }; -EXTERN_C void boot_DynaLoader (pTHXo_ CV* cv); +EXTERN_C void boot_DynaLoader (pTHX_ CV* cv); static void -xs_init(pTHXo) +xs_init(pTHX) { char *file = __FILE__; dXSUB_SYS; @@ -108,9 +104,6 @@ perl_alloc_override(struct IPerlMem** ppMem, struct IPerlMem** ppMemShared, pHost->m_pHostperlSock, pHost->m_pHostperlProc); if (my_perl) { -#ifdef PERL_OBJECT - CPerlObj* pPerl = (CPerlObj*)my_perl; -#endif w32_internal_host = pHost; } } @@ -133,9 +126,6 @@ perl_alloc(void) pHost->m_pHostperlSock, pHost->m_pHostperlProc); if (my_perl) { -#ifdef PERL_OBJECT - CPerlObj* pPerl = (CPerlObj*)my_perl; -#endif w32_internal_host = pHost; } } @@ -149,108 +139,6 @@ win32_delete_internal_host(void *h) delete host; } -#ifdef PERL_OBJECT - -EXTERN_C void -perl_construct(PerlInterpreter* my_perl) -{ - CPerlObj* pPerl = (CPerlObj*)my_perl; - try - { - Perl_construct(); - } - catch(...) - { - win32_fprintf(stderr, "%s\n", - "Error: Unable to construct data structures"); - perl_free(my_perl); - } -} - -EXTERN_C void -perl_destruct(PerlInterpreter* my_perl) -{ - CPerlObj* pPerl = (CPerlObj*)my_perl; -#ifdef DEBUGGING - Perl_destruct(); -#else - try - { - Perl_destruct(); - } - catch(...) - { - } -#endif -} - -EXTERN_C void -perl_free(PerlInterpreter* my_perl) -{ - CPerlObj* pPerl = (CPerlObj*)my_perl; - void *host = w32_internal_host; -#ifdef DEBUGGING - Perl_free(); -#else - try - { - Perl_free(); - } - catch(...) - { - } -#endif - win32_delete_internal_host(host); - PERL_SET_THX(NULL); -} - -EXTERN_C int -perl_run(PerlInterpreter* my_perl) -{ - CPerlObj* pPerl = (CPerlObj*)my_perl; - int retVal; -#ifdef DEBUGGING - retVal = Perl_run(); -#else - try - { - retVal = Perl_run(); - } - catch(...) - { - win32_fprintf(stderr, "Error: Runtime exception\n"); - retVal = -1; - } -#endif - return retVal; -} - -EXTERN_C int -perl_parse(PerlInterpreter* my_perl, void (*xsinit)(CPerlObj*), int argc, char** argv, char** env) -{ - int retVal; - CPerlObj* pPerl = (CPerlObj*)my_perl; -#ifdef DEBUGGING - retVal = Perl_parse(xsinit, argc, argv, env); -#else - try - { - retVal = Perl_parse(xsinit, argc, argv, env); - } - catch(...) - { - win32_fprintf(stderr, "Error: Parse exception\n"); - retVal = -1; - } -#endif - *win32_errno() = 0; - return retVal; -} - -#undef PL_perl_destruct_level -#define PL_perl_destruct_level int dummy - -#endif /* PERL_OBJECT */ #endif /* PERL_IMPLICIT_SYS */ EXTERN_C HANDLE w32_perldll_handle; @@ -295,23 +183,7 @@ RunPerl(int argc, char **argv, char **env) exitstatus = perl_parse(my_perl, xs_init, argc, argv, env); if (!exitstatus) { #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 exitstatus = perl_run(new_perl); PERL_SET_THX(my_perl); #else @@ -377,7 +249,7 @@ DllMain(HANDLE hModule, /* DLL module handle */ PerlIO_cleanup() was done here but fails (B). */ EndSockets(); -#if defined(USE_THREADS) || defined(USE_ITHREADS) +#if defined(USE_5005THREADS) || defined(USE_ITHREADS) if (PL_curinterp) FREE_THREAD_KEY; #endif @@ -400,7 +272,7 @@ DllMain(HANDLE hModule, /* DLL module handle */ #if defined(USE_ITHREADS) && defined(PERL_IMPLICIT_SYS) EXTERN_C PerlInterpreter * perl_clone_host(PerlInterpreter* proto_perl, UV flags) { - dTHXo; + dTHX; CPerlHost *h; h = new CPerlHost(*(CPerlHost*)PL_sys_intern.internal_host); proto_perl = perl_clone_using(proto_perl, flags,