X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/7bd379e81ea13d83ac434499c69ddde30e5c4259..af23cf166818c49709cd7a912b616557b93c8ea1:/win32/perlhost.h diff --git a/win32/perlhost.h b/win32/perlhost.h index fe026dd..be7d61d 100644 --- a/win32/perlhost.h +++ b/win32/perlhost.h @@ -21,10 +21,15 @@ #include "vmem.h" #include "vdir.h" +#ifndef WC_NO_BEST_FIT_CHARS +# define WC_NO_BEST_FIT_CHARS 0x00000400 +#endif + START_EXTERN_C -extern char * g_win32_get_privlib(const char *pl); -extern char * g_win32_get_sitelib(const char *pl); -extern char * g_win32_get_vendorlib(const char *pl); +extern char * g_win32_get_privlib(const char *pl, STRLEN *const len); +extern char * g_win32_get_sitelib(const char *pl, STRLEN *const len); +extern char * g_win32_get_vendorlib(const char *pl, + STRLEN *const len); extern char * g_getlogin(void); END_EXTERN_C @@ -513,21 +518,22 @@ PerlEnvOsId(struct IPerlEnv* piPerl) } char* -PerlEnvLibPath(struct IPerlEnv* piPerl, const char *pl) +PerlEnvLibPath(struct IPerlEnv* piPerl, const char *pl, STRLEN *const len) { - return g_win32_get_privlib(pl); + return g_win32_get_privlib(pl, len); } char* -PerlEnvSiteLibPath(struct IPerlEnv* piPerl, const char *pl) +PerlEnvSiteLibPath(struct IPerlEnv* piPerl, const char *pl, STRLEN *const len) { - return g_win32_get_sitelib(pl); + return g_win32_get_sitelib(pl, len); } char* -PerlEnvVendorLibPath(struct IPerlEnv* piPerl, const char *pl) +PerlEnvVendorLibPath(struct IPerlEnv* piPerl, const char *pl, + STRLEN *const len) { - return g_win32_get_vendorlib(pl); + return g_win32_get_vendorlib(pl, len); } void @@ -612,14 +618,14 @@ PerlStdIOGetc(struct IPerlStdIO* piPerl, FILE* pf) return win32_getc(pf); } -char* +STDCHAR* PerlStdIOGetBase(struct IPerlStdIO* piPerl, FILE* pf) { #ifdef FILE_base FILE *f = pf; return FILE_base(f); #else - return Nullch; + return NULL; #endif } @@ -645,14 +651,14 @@ PerlStdIOGetCnt(struct IPerlStdIO* piPerl, FILE* pf) #endif } -char* +STDCHAR* PerlStdIOGetPtr(struct IPerlStdIO* piPerl, FILE* pf) { #ifdef USE_STDIO_PTR FILE *f = pf; return FILE_ptr(f); #else - return Nullch; + return NULL; #endif } @@ -738,7 +744,7 @@ PerlStdIOSetCnt(struct IPerlStdIO* piPerl, FILE* pf, int n) } void -PerlStdIOSetPtr(struct IPerlStdIO* piPerl, FILE* pf, char * ptr) +PerlStdIOSetPtr(struct IPerlStdIO* piPerl, FILE* pf, STDCHAR * ptr) { #ifdef STDIO_PTR_LVALUE FILE *f = pf; @@ -985,13 +991,20 @@ PerlLIOFileStat(struct IPerlLIO* piPerl, int handle, Stat_t *buffer) int PerlLIOIOCtl(struct IPerlLIO* piPerl, int i, unsigned int u, char *data) { - return win32_ioctlsocket((SOCKET)i, (long)u, (u_long*)data); + u_long u_long_arg; + int retval; + + /* mauke says using memcpy avoids alignment issues */ + memcpy(&u_long_arg, data, sizeof u_long_arg); + retval = win32_ioctlsocket((SOCKET)i, (long)u, &u_long_arg); + memcpy(data, &u_long_arg, sizeof u_long_arg); + return retval; } int PerlLIOIsatty(struct IPerlLIO* piPerl, int fd) { - return isatty(fd); + return win32_isatty(fd); } int @@ -1607,9 +1620,7 @@ PerlProcKill(struct IPerlProc* piPerl, int pid, int sig) int PerlProcKillpg(struct IPerlProc* piPerl, int pid, int sig) { - dTHX; - Perl_croak(aTHX_ "killpg not implemented!\n"); - return 0; + return win32_kill(pid, -sig); } int @@ -1736,7 +1747,7 @@ win32_start_child(LPVOID arg) parent_message_hwnd = w32_message_hwnd; w32_message_hwnd = win32_create_message_window(); if (parent_message_hwnd != NULL) - PostMessage(parent_message_hwnd, WM_USER_MESSAGE, w32_pseudo_id, (LONG)w32_message_hwnd); + PostMessage(parent_message_hwnd, WM_USER_MESSAGE, w32_pseudo_id, (LPARAM)w32_message_hwnd); /* push a zero on the stack (we are the child) */ { @@ -1751,13 +1762,23 @@ win32_start_child(LPVOID arg) { dJMPENV; - volatile int oldscope = PL_scopestack_ix; + volatile int oldscope = 1; /* We are responsible for all scopes */ restart: JMPENV_PUSH(status); switch (status) { case 0: CALLRUNOPS(aTHX); + /* We may have additional unclosed scopes if fork() was called + * from within a BEGIN block. See perlfork.pod for more details. + * We cannot clean up these other scopes because they belong to a + * different interpreter, but we also cannot leave PL_scopestack_ix + * dangling because that can trigger an assertion in perl_destruct(). + */ + if (PL_scopestack_ix > oldscope) { + PL_scopestack[oldscope-1] = PL_scopestack[PL_scopestack_ix-1]; + PL_scopestack_ix = oldscope; + } status = 0; break; case 2: @@ -1773,7 +1794,7 @@ restart: if (PL_restartop) { POPSTACK_TO(PL_mainstack); PL_op = PL_restartop; - PL_restartop = Nullop; + PL_restartop = (OP*)NULL; goto restart; } PerlIO_printf(Perl_error_log, "panic: restartop\n"); @@ -1785,7 +1806,7 @@ restart: /* XXX hack to avoid perl_destruct() freeing optree */ win32_checkTLS(my_perl); - PL_main_root = Nullop; + PL_main_root = (OP*)NULL; } win32_checkTLS(my_perl); @@ -1824,7 +1845,8 @@ PerlProcFork(struct IPerlProc* piPerl) return -1; } h = new CPerlHost(*(CPerlHost*)w32_internal_host); - PerlInterpreter *new_perl = perl_clone_using((PerlInterpreter*)aTHX, 1, + PerlInterpreter *new_perl = perl_clone_using((PerlInterpreter*)aTHX, + CLONEf_COPY_STACKS, h->m_pHostperlMem, h->m_pHostperlMemShared, h->m_pHostperlMemParse, @@ -2240,16 +2262,15 @@ char* CPerlHost::GetChildDir(void) { dTHX; - int length; char* ptr; + size_t length; + Newx(ptr, MAX_PATH+1, char); - if(ptr) { - m_pvDir->GetCurrentDirectoryA(MAX_PATH+1, ptr); - length = strlen(ptr); - if (length > 3) { - if ((ptr[length-1] == '\\') || (ptr[length-1] == '/')) - ptr[length-1] = 0; - } + m_pvDir->GetCurrentDirectoryA(MAX_PATH+1, ptr); + length = strlen(ptr); + if (length > 3) { + if ((ptr[length-1] == '\\') || (ptr[length-1] == '/')) + ptr[length-1] = 0; } return ptr; }