utf8-ize @ARGV when -C switch is used on Windows
[p5sagit/p5-mst-13.2.git] / win32 / perllib.c
index 1b8516c..3aed241 100644 (file)
@@ -87,8 +87,6 @@ perl_get_host_info(struct IPerlMemInfo* perlMemInfo,
     }
 }
 
-#ifdef PERL_OBJECT
-
 EXTERN_C PerlInterpreter*
 perl_alloc_override(struct IPerlMem** ppMem, struct IPerlMem** ppMemShared,
                 struct IPerlMem** ppMemParse, struct IPerlEnv** ppEnv,
@@ -97,33 +95,26 @@ perl_alloc_override(struct IPerlMem** ppMem, struct IPerlMem** ppMemShared,
                 struct IPerlProc** ppProc)
 {
     PerlInterpreter *my_perl = NULL;
-    try
-    {
-       CPerlHost* pHost = new CPerlHost(ppMem, ppMemShared, ppMemParse, ppEnv,
-                                        ppStdIO, ppLIO, ppDir, ppSock, ppProc);
-
-       if (pHost) {
-           my_perl = perl_alloc_using(pHost->m_pHostperlMem,
-                                      pHost->m_pHostperlMemShared,
-                                      pHost->m_pHostperlMemParse,
-                                      pHost->m_pHostperlEnv,
-                                      pHost->m_pHostperlStdIO,
-                                      pHost->m_pHostperlLIO,
-                                      pHost->m_pHostperlDir,
-                                      pHost->m_pHostperlSock,
-                                      pHost->m_pHostperlProc);
-           if (my_perl) {
-               CPerlObj* pPerl = (CPerlObj*)my_perl;
-               w32_internal_host = pHost;
-           }
+    CPerlHost* pHost = new CPerlHost(ppMem, ppMemShared, ppMemParse, ppEnv,
+                                    ppStdIO, ppLIO, ppDir, ppSock, ppProc);
+
+    if (pHost) {
+       my_perl = perl_alloc_using(pHost->m_pHostperlMem,
+                                  pHost->m_pHostperlMemShared,
+                                  pHost->m_pHostperlMemParse,
+                                  pHost->m_pHostperlEnv,
+                                  pHost->m_pHostperlStdIO,
+                                  pHost->m_pHostperlLIO,
+                                  pHost->m_pHostperlDir,
+                                  pHost->m_pHostperlSock,
+                                  pHost->m_pHostperlProc);
+       if (my_perl) {
+#ifdef PERL_OBJECT
+           CPerlObj* pPerl = (CPerlObj*)my_perl;
+#endif
+           w32_internal_host = pHost;
        }
     }
-    catch(...)
-    {
-       win32_fprintf(stderr, "%s\n", "Error: Unable to allocate memory");
-       my_perl = NULL;
-    }
-
     return my_perl;
 }
 
@@ -131,34 +122,29 @@ EXTERN_C PerlInterpreter*
 perl_alloc(void)
 {
     PerlInterpreter* my_perl = NULL;
-    try
-    {
-       CPerlHost* pHost = new CPerlHost();
-       if (pHost) {
-           my_perl = perl_alloc_using(pHost->m_pHostperlMem,
-                                      pHost->m_pHostperlMemShared,
-                                      pHost->m_pHostperlMemParse,
-                                      pHost->m_pHostperlEnv,
-                                      pHost->m_pHostperlStdIO,
-                                      pHost->m_pHostperlLIO,
-                                      pHost->m_pHostperlDir,
-                                      pHost->m_pHostperlSock,
-                                      pHost->m_pHostperlProc);
-           if (my_perl) {
-               CPerlObj* pPerl = (CPerlObj*)my_perl;
-               w32_internal_host = pHost;
-           }
+    CPerlHost* pHost = new CPerlHost();
+    if (pHost) {
+       my_perl = perl_alloc_using(pHost->m_pHostperlMem,
+                                  pHost->m_pHostperlMemShared,
+                                  pHost->m_pHostperlMemParse,
+                                  pHost->m_pHostperlEnv,
+                                  pHost->m_pHostperlStdIO,
+                                  pHost->m_pHostperlLIO,
+                                  pHost->m_pHostperlDir,
+                                  pHost->m_pHostperlSock,
+                                  pHost->m_pHostperlProc);
+       if (my_perl) {
+#ifdef PERL_OBJECT
+           CPerlObj* pPerl = (CPerlObj*)my_perl;
+#endif
+           w32_internal_host = pHost;
        }
     }
-    catch(...)
-    {
-       win32_fprintf(stderr, "%s\n", "Error: Unable to allocate memory");
-       my_perl = NULL;
-    }
-
     return my_perl;
 }
 
+#ifdef PERL_OBJECT
+
 EXTERN_C void
 perl_construct(PerlInterpreter* my_perl)
 {
@@ -174,7 +160,7 @@ perl_construct(PerlInterpreter* my_perl)
        CPerlHost* pHost = (CPerlHost*)w32_internal_host;
        Perl_free();
        delete pHost;
-       SetPerlInterpreter(NULL);
+       PERL_SET_THX(NULL);
     }
 }
 
@@ -214,7 +200,7 @@ perl_free(PerlInterpreter* my_perl)
     {
     }
 #endif
-    SetPerlInterpreter(NULL);
+    PERL_SET_THX(NULL);
 }
 
 EXTERN_C int
@@ -263,49 +249,11 @@ perl_parse(PerlInterpreter* my_perl, void (*xsinit)(CPerlObj*), int argc, char**
 #undef PL_perl_destruct_level
 #define PL_perl_destruct_level int dummy
 
-#else /* !PERL_OBJECT */
-
-EXTERN_C PerlInterpreter*
-perl_alloc(void)
-{
-    PerlInterpreter *my_perl = NULL;
-    CPerlHost* pHost = new CPerlHost();
-    if (pHost) {
-       my_perl = perl_alloc_using(pHost->m_pHostperlMem,
-                                  pHost->m_pHostperlMemShared,
-                                  pHost->m_pHostperlMemParse,
-                                  pHost->m_pHostperlEnv,
-                                  pHost->m_pHostperlStdIO,
-                                  pHost->m_pHostperlLIO,
-                                  pHost->m_pHostperlDir,
-                                  pHost->m_pHostperlSock,
-                                  pHost->m_pHostperlProc);
-       if (my_perl) {
-           w32_internal_host = pHost;
-       }
-    }
-    return my_perl;
-}
-
 #endif /* PERL_OBJECT */
 #endif /* PERL_IMPLICIT_SYS */
 
 EXTERN_C HANDLE w32_perldll_handle;
 
-static DWORD g_TlsAllocIndex;
-
-EXTERN_C DllExport bool
-SetPerlInterpreter(void *interp)
-{
-    return TlsSetValue(g_TlsAllocIndex, interp);
-}
-
-EXTERN_C DllExport void*
-GetPerlInterpreter(void)
-{
-    return TlsGetValue(g_TlsAllocIndex);
-}
-
 EXTERN_C DllExport int
 RunPerl(int argc, char **argv, char **env)
 {
@@ -365,7 +313,7 @@ RunPerl(int argc, char **argv, char **env)
        new_perl = perl_clone(my_perl, 1);
 #  endif
        exitstatus = perl_run( new_perl );
-       SetPerlInterpreter(my_perl);
+       PERL_SET_THX(my_perl);
 #else
        exitstatus = perl_run( my_perl );
 #endif
@@ -375,7 +323,7 @@ RunPerl(int argc, char **argv, char **env)
     perl_free( my_perl );
 #ifdef USE_ITHREADS
     if (new_perl) {
-       SetPerlInterpreter(new_perl);
+       PERL_SET_THX(new_perl);
        perl_destruct(new_perl);
        perl_free(new_perl);
     }
@@ -403,8 +351,7 @@ DllMain(HANDLE hModule,             /* DLL module handle */
        setmode( fileno( stderr ), O_BINARY );
        _fmode = O_BINARY;
 #endif
-       g_TlsAllocIndex = TlsAlloc();
-       DisableThreadLibraryCalls(hModule);
+       DisableThreadLibraryCalls((HMODULE)hModule);
        w32_perldll_handle = hModule;
        break;
 
@@ -412,7 +359,6 @@ DllMain(HANDLE hModule,             /* DLL module handle */
         * process termination or call to FreeLibrary.
         */
     case DLL_PROCESS_DETACH:
-       TlsFree(g_TlsAllocIndex);
        break;
 
        /* The attached process creates a new thread. */