perlre: fix typo

[perl5.git] / win32 / win32.c

diff --git a/win32/win32.c b/win32/win32.c
index bfc02fd..bda5356 100644 (file)
--- a/win32/win32.c
+++ b/win32/win32.c
@@ -132,7 +132,7 @@ static long tokenize(const char *str, char **dest, char ***destv);
 static void    get_shell(void);
 static char*   find_next_space(const char *s);
 static int     do_spawn2(pTHX_ const char *cmd, int exectype);
-static long    find_pid(int pid);
+static long    find_pid(pTHX_ int pid);
 static void    remove_dead_process(long child);
 static int     terminate_process(DWORD pid, HANDLE process_handle, int sig);
 static int     my_kill(int pid, int sig);
@@ -148,7 +148,7 @@ static LRESULT      win32_process_message(HWND hwnd, UINT msg,
                        WPARAM wParam, LPARAM lParam);
 
 #ifdef USE_ITHREADS
-static long    find_pseudo_pid(int pid);
+static long    find_pseudo_pid(pTHX_ int pid);
 static void    remove_dead_pseudo_process(long child);
 static HWND    get_hwnd_delay(pTHX, long child, DWORD tries);
 #endif
@@ -384,7 +384,6 @@ get_emd_part(SV **prev_pathp, STRLEN *const len, char *trailing_path, ...)
 EXTERN_C char *
 win32_get_privlib(const char *pl, STRLEN *const len)
 {
-    dTHX;
     char *stdlib = "lib";
     char buffer[MAX_PATH+1];
     SV *sv = NULL;
@@ -402,7 +401,6 @@ static char *
 win32_get_xlib(const char *pl, const char *xlib, const char *libname,
               STRLEN *const len)
 {
-    dTHX;
     char regstr[40];
     char pathstr[MAX_PATH+1];
     SV *sv1 = NULL;
@@ -430,6 +428,7 @@ win32_get_xlib(const char *pl, const char *xlib, const char *libname,
     if (!sv1) {
        sv1 = sv2;
     } else if (sv2) {
+        dTHX;
        sv_catpvn(sv1, ";", 1);
        sv_catsv(sv1, sv2);
     }
@@ -544,7 +543,6 @@ tokenize(const char *str, char **dest, char ***destv)
     char **retvstart = 0;
     int items = -1;
     if (str) {
-       dTHX;
        int slen = strlen(str);
        char *ret;
        char **retv;
@@ -815,7 +813,7 @@ Perl_do_exec(pTHX_ const char *cmd)
 DllExport DIR *
 win32_opendir(const char *filename)
 {
-    dTHX;
+    dTHXa(NULL);
     DIR                        *dirp;
     long               len;
     long               idx;
@@ -854,6 +852,7 @@ win32_opendir(const char *filename)
 
     /* do the FindFirstFile call */
     MultiByteToWideChar(CP_ACP, 0, scanname, -1, wscanname, sizeof(wscanname)/sizeof(WCHAR));
+    aTHXa(PERL_GET_THX);
     dirp->handle = FindFirstFileW(PerlDir_mapW(wscanname), &wFindData);
 
     if (dirp->handle == INVALID_HANDLE_VALUE) {
@@ -924,7 +923,6 @@ win32_readdir(DIR *dirp)
        /* Now set up for the next call to readdir */
        dirp->curr += len + 1;
        if (dirp->curr >= dirp->end) {
-           dTHX;
            BOOL res;
            char buffer[MAX_PATH*2];
 
@@ -1006,7 +1004,6 @@ win32_rewinddir(DIR *dirp)
 DllExport int
 win32_closedir(DIR *dirp)
 {
-    dTHX;
     if (dirp->handle != INVALID_HANDLE_VALUE)
        FindClose(dirp->handle);
     Safefree(dirp->start);
@@ -1153,9 +1150,8 @@ retry:
 }
 
 static long
-find_pid(int pid)
+find_pid(pTHX_ int pid)
 {
-    dTHX;
     long child = w32_num_children;
     while (--child >= 0) {
        if ((int)w32_child_pids[child] == pid)
@@ -1180,9 +1176,8 @@ remove_dead_process(long child)
 
 #ifdef USE_ITHREADS
 static long
-find_pseudo_pid(int pid)
+find_pseudo_pid(pTHX_ int pid)
 {
-    dTHX;
     long child = w32_num_pseudo_children;
     while (--child >= 0) {
        if ((int)w32_pseudo_child_pids[child] == pid)
@@ -1364,7 +1359,7 @@ win32_kill(int pid, int sig)
 #ifdef USE_ITHREADS
     if (pid < 0) {
        /* it is a pseudo-forked child */
-       child = find_pseudo_pid(-pid);
+       child = find_pseudo_pid(aTHX_ -pid);
        if (child >= 0) {
            HANDLE hProcess = w32_pseudo_child_handles[child];
            switch (sig) {
@@ -1419,7 +1414,7 @@ win32_kill(int pid, int sig)
     else
 #endif
     {
-       child = find_pid(pid);
+       child = find_pid(aTHX_ pid);
        if (child >= 0) {
             if (my_kill(pid, sig)) {
                 DWORD exitcode = 0;
@@ -1443,9 +1438,9 @@ win32_kill(int pid, int sig)
 DllExport int
 win32_stat(const char *path, Stat_t *sbuf)
 {
-    dTHX;
     char       buffer[MAX_PATH+1];
     int                l = strlen(path);
+    dTHX;
     int                res;
     int         nlink = 1;
     BOOL        expect_dir = FALSE;
@@ -1666,16 +1661,19 @@ win32_longpath(char *path)
 static void
 out_of_memory(void)
 {
-    if (PL_curinterp) {
-        dTHX;
-        /* Can't use PerlIO to write as it allocates memory */
-        PerlLIO_write(PerlIO_fileno(Perl_error_log),
-                      PL_no_mem, strlen(PL_no_mem));
-        my_exit(1);
-    }
+    if (PL_curinterp)
+       croak_no_mem();
     exit(1);
 }
 
+void
+win32_croak_not_implemented(const char * fname)
+{
+    PERL_ARGS_ASSERT_WIN32_CROAK_NOT_IMPLEMENTED;
+
+    Perl_croak_nocontext("%s not implemented!\n", fname);
+}
+
 /* Converts a wide character (UTF-16) string to the Windows ANSI code page,
  * potentially using the system's default replacement character for any
  * unrepresentable characters. The caller must free() the returned string. */
@@ -1839,13 +1837,12 @@ win32_getenv(const char *name)
 DllExport int
 win32_putenv(const char *name)
 {
-    dTHX;
     char* curitem;
     char* val;
     int relval = -1;
 
     if (name) {
-        Newx(curitem,strlen(name)+1,char);
+        curitem = (char *) win32_malloc(strlen(name)+1);
         strcpy(curitem, name);
         val = strchr(curitem, '=');
         if (val) {
@@ -1869,7 +1866,7 @@ win32_putenv(const char *name)
             if (SetEnvironmentVariableA(curitem, *val ? val : NULL))
                 relval = 0;
         }
-        Safefree(curitem);
+        win32_free(curitem);
     }
     return relval;
 }
@@ -2273,12 +2270,11 @@ win32_msgwait(pTHX_ DWORD count, LPHANDLE handles, DWORD timeout, LPDWORD result
 }
 
 int
-win32_internal_wait(int *status, DWORD timeout)
+win32_internal_wait(pTHX_ int *status, DWORD timeout)
 {
     /* XXX this wait emulation only knows about processes
      * spawned via win32_spawnvp(P_NOWAIT, ...).
      */
-    dTHX;
     int i, retval;
     DWORD exitcode, waitcode;
 
@@ -2344,10 +2340,10 @@ win32_waitpid(int pid, int *status, int flags)
     int retval = -1;
     long child;
     if (pid == -1)                             /* XXX threadid == 1 ? */
-       return win32_internal_wait(status, timeout);
+       return win32_internal_wait(aTHX_ status, timeout);
 #ifdef USE_ITHREADS
     else if (pid < 0) {
-       child = find_pseudo_pid(-pid);
+       child = find_pseudo_pid(aTHX_ -pid);
        if (child >= 0) {
            HANDLE hThread = w32_pseudo_child_handles[child];
            DWORD waitcode;
@@ -2371,7 +2367,7 @@ win32_waitpid(int pid, int *status, int flags)
     else {
        HANDLE hProcess;
        DWORD waitcode;
-       child = find_pid(pid);
+       child = find_pid(aTHX_ pid);
        if (child >= 0) {
            hProcess = w32_child_handles[child];
            win32_msgwait(aTHX_ 1, &hProcess, timeout, &waitcode);
@@ -2416,7 +2412,8 @@ win32_waitpid(int pid, int *status, int flags)
 DllExport int
 win32_wait(int *status)
 {
-    return win32_internal_wait(status, INFINITE);
+    dTHX;
+    return win32_internal_wait(aTHX_ status, INFINITE);
 }
 
 DllExport unsigned int
@@ -2588,10 +2585,11 @@ win32_strerror(int e)
 #endif
 
     if (e < 0 || e > sys_nerr) {
-        dTHX;
+        dTHXa(NULL);
        if (e < 0)
            e = GetLastError();
 
+       aTHXa(PERL_GET_THX);
        if (FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM
                          |FORMAT_MESSAGE_IGNORE_INSERTS, NULL, e, 0,
                          w32_strerror_buffer, sizeof(w32_strerror_buffer),
@@ -2685,7 +2683,7 @@ win32_fwrite(const void *buf, size_t size, size_t count, FILE *fp)
 DllExport FILE *
 win32_fopen(const char *filename, const char *mode)
 {
-    dTHX;
+    dTHXa(NULL);
     FILE *f;
 
     if (!*filename)
@@ -2694,6 +2692,7 @@ win32_fopen(const char *filename, const char *mode)
     if (stricmp(filename, "/dev/null")==0)
        filename = "NUL";
 
+    aTHXa(PERL_GET_THX);
     f = fopen(PerlDir_mapA(filename), mode);
     /* avoid buffering headaches for child processes */
     if (f && *mode == 'a')
@@ -2704,7 +2703,6 @@ win32_fopen(const char *filename, const char *mode)
 DllExport FILE *
 win32_fdopen(int handle, const char *mode)
 {
-    dTHX;
     FILE *f;
     f = fdopen(handle, (char *) mode);
     /* avoid buffering headaches for child processes */
@@ -2716,17 +2714,22 @@ win32_fdopen(int handle, const char *mode)
 DllExport FILE *
 win32_freopen(const char *path, const char *mode, FILE *stream)
 {
-    dTHX;
+    dTHXa(NULL);
     if (stricmp(path, "/dev/null")==0)
        path = "NUL";
 
+    aTHXa(PERL_GET_THX);
     return freopen(PerlDir_mapA(path), mode, stream);
 }
 
 DllExport int
 win32_fclose(FILE *pf)
 {
+#ifdef WIN32_NO_SOCKETS
+    return fclose(pf);
+#else
     return my_fclose(pf);      /* defined in win32sck.c */
+#endif
 }
 
 DllExport int
@@ -2835,7 +2838,6 @@ win32_rewind(FILE *pf)
 DllExport int
 win32_tmpfd(void)
 {
-    dTHX;
     char prefix[MAX_PATH+1];
     char filename[MAX_PATH+1];
     DWORD len = GetTempPath(MAX_PATH, prefix);
@@ -2852,6 +2854,7 @@ win32_tmpfd(void)
            if (fh != INVALID_HANDLE_VALUE) {
                int fd = win32_open_osfhandle((intptr_t)fh, 0);
                if (fd >= 0) {
+                   PERL_DEB(dTHX;)
                    DEBUG_p(PerlIO_printf(Perl_debug_log,
                                          "Created tmpfile=%s\n",filename));
                    return fd;
@@ -2897,8 +2900,7 @@ win32_pipe(int *pfd, unsigned int size, int mode)
 DllExport PerlIO*
 win32_popenlist(const char *mode, IV narg, SV **args)
 {
- dTHX;
- Perl_croak(aTHX_ "List form of pipe open not implemented");
+ Perl_croak_nocontext("List form of pipe open not implemented");
  return NULL;
 }
 
@@ -2914,7 +2916,6 @@ win32_popen(const char *command, const char *mode)
 #ifdef USE_RTL_POPEN
     return _popen(command, mode);
 #else
-    dTHX;
     int p[2];
     int parent, child;
     int stdfd, oldfd;
@@ -3067,13 +3068,13 @@ win32_pclose(PerlIO *pf)
 DllExport int
 win32_link(const char *oldname, const char *newname)
 {
-    dTHX;
+    dTHXa(NULL);
     WCHAR wOldName[MAX_PATH+1];
     WCHAR wNewName[MAX_PATH+1];
 
     if (MultiByteToWideChar(CP_ACP, 0, oldname, -1, wOldName, MAX_PATH+1) &&
         MultiByteToWideChar(CP_ACP, 0, newname, -1, wNewName, MAX_PATH+1) &&
-       (wcscpy(wOldName, PerlDir_mapW(wOldName)),
+       ((aTHXa(PERL_GET_THX)), wcscpy(wOldName, PerlDir_mapW(wOldName)),
         CreateHardLinkW(PerlDir_mapW(wNewName), wOldName, NULL)))
     {
        return 0;
@@ -3225,7 +3226,7 @@ win32_tell(int fd)
 DllExport int
 win32_open(const char *path, int flag, ...)
 {
-    dTHX;
+    dTHXa(NULL);
     va_list ap;
     int pmode;
 
@@ -3236,6 +3237,7 @@ win32_open(const char *path, int flag, ...)
     if (stricmp(path, "/dev/null")==0)
        path = "NUL";
 
+    aTHXa(PERL_GET_THX);
     return open(PerlDir_mapA(path), flag, pmode);
 }
 
@@ -3245,7 +3247,11 @@ extern int my_close(int);        /* in win32sck.c */
 DllExport int
 win32_close(int fd)
 {
+#ifdef WIN32_NO_SOCKETS
+    return close(fd);
+#else
     return my_close(fd);
+#endif
 }
 
 DllExport int
@@ -3316,7 +3322,6 @@ win32_rmdir(const char *dir)
 DllExport int
 win32_chdir(const char *dir)
 {
-    dTHX;
     if (!dir) {
        errno = ENOENT;
        return -1;
@@ -3342,7 +3347,7 @@ win32_chmod(const char *path, int mode)
 static char *
 create_command_line(char *cname, STRLEN clen, const char * const *args)
 {
-    dTHX;
+    PERL_DEB(dTHX;)
     int index, argc;
     char *cmd, *ptr;
     const char *arg;
@@ -3497,7 +3502,6 @@ create_command_line(char *cname, STRLEN clen, const char * const *args)
 static char *
 qualified_path(const char *cmd)
 {
-    dTHX;
     char *pathstr;
     char *fullcmd, *curfullcmd;
     STRLEN cmdlen = 0;
@@ -3514,8 +3518,10 @@ qualified_path(const char *cmd)
     }
 
     /* look in PATH */
-    pathstr = PerlEnv_getenv("PATH");
-
+    {
+       dTHX;
+       pathstr = PerlEnv_getenv("PATH");
+    }
     /* worst case: PATH is a single directory; we need additional space
      * to append "/", ".exe" and trailing "\0" */
     Newx(fullcmd, (pathstr ? strlen(pathstr) : 0) + cmdlen + 6, char);
@@ -3621,7 +3627,6 @@ win32_clearenv(void)
 DllExport char*
 win32_get_childdir(void)
 {
-    dTHX;
     char* ptr;
     char szfilename[MAX_PATH+1];
 
@@ -3634,7 +3639,6 @@ win32_get_childdir(void)
 DllExport void
 win32_free_childdir(char* d)
 {
-    dTHX;
     Safefree(d);
 }
 
@@ -3656,7 +3660,7 @@ win32_spawnvp(int mode, const char *cmdname, const char *const *argv)
 #ifdef USE_RTL_SPAWNVP
     return spawnvp(mode, cmdname, (char * const *)argv);
 #else
-    dTHX;
+    dTHXa(NULL);
     int ret;
     void* env;
     char* dir;
@@ -3689,6 +3693,7 @@ win32_spawnvp(int mode, const char *cmdname, const char *const *argv)
 
     cmd = create_command_line(cname, clen, argv);
 
+    aTHXa(PERL_GET_THX);
     env = PerlEnv_get_childenv();
     dir = PerlEnv_get_childdir();
 
@@ -4089,7 +4094,7 @@ win32_fdupopen(FILE *pf)
 DllExport void*
 win32_dynaload(const char* filename)
 {
-    dTHX;
+    dTHXa(NULL);
     char buf[MAX_PATH+1];
     const char *first;
 
@@ -4109,6 +4114,7 @@ win32_dynaload(const char* filename)
            filename = buf;
        }
     }
+    aTHXa(PERL_GET_THX);
     return LoadLibraryExA(PerlDir_mapA(filename), NULL, LOAD_WITH_ALTERED_SEARCH_PATH);
 }
 
@@ -4140,15 +4146,18 @@ XS(w32_SetChildShowWindow)
 void
 Perl_init_os_extras(void)
 {
-    dTHX;
+    dTHXa(NULL);
     char *file = __FILE__;
 
     /* Initialize Win32CORE if it has been statically linked. */
 #ifndef PERL_IS_MINIPERL
     void (*pfn_init)(pTHX);
     pfn_init = (void (*)(pTHX))GetProcAddress((HMODULE)w32_perldll_handle, "init_Win32CORE");
+    aTHXa(PERL_GET_THX);
     if (pfn_init)
         pfn_init(aTHX);
+#else
+    aTHXa(PERL_GET_THX);
 #endif
 
     newXS("Win32::SetChildShowWindow", w32_SetChildShowWindow, file);
@@ -4240,6 +4249,10 @@ ansify_path(void)
     wide_path = (WCHAR*)win32_malloc(len*sizeof(WCHAR));
     while (wide_path) {
         size_t newlen = GetEnvironmentVariableW(L"PATH", wide_path, len);
+        if (newlen == 0) {
+            win32_free(wide_path);
+            return;
+        }
         if (newlen < len)
             break;
         len = newlen;
@@ -4360,7 +4373,6 @@ Perl_win32_init(int *argcp, char ***argvp)
 void
 Perl_win32_term(void)
 {
-    dTHX;
     HINTS_REFCNT_TERM;
     OP_REFCNT_TERM;
     PERLIO_TERM;
@@ -4378,7 +4390,7 @@ win32_get_child_IO(child_IO_table* ptbl)
 Sighandler_t
 win32_signal(int sig, Sighandler_t subcode)
 {
-    dTHX;
+    dTHXa(NULL);
     if (sig < SIG_SIZE) {
        int save_errno = errno;
        Sighandler_t result;
@@ -4391,6 +4403,7 @@ win32_signal(int sig, Sighandler_t subcode)
 #ifdef SET_INVALID_PARAMETER_HANDLER
        set_silent_invalid_parameter_handler(oldvalue);
 #endif
+       aTHXa(PERL_GET_THX);
        if (result == SIG_ERR) {
            result = w32_sighandler[sig];
            errno = save_errno;
@@ -4430,14 +4443,14 @@ win32_process_message(HWND hwnd, UINT msg, WPARAM wParam, LPARAM lParam)
      * are relativley infrequent code-paths, is better than the added
      * complexity of getting the correct context passed into
      * win32_create_message_window() */
+    dTHX;
 
     switch(msg) {
 
 #ifdef USE_ITHREADS
         case WM_USER_MESSAGE: {
-            long child = find_pseudo_pid((int)wParam);
+            long child = find_pseudo_pid(aTHX_ (int)wParam);
             if (child >= 0) {
-                dTHX;
                 w32_pseudo_child_message_hwnds[child] = (HWND)lParam;
                 return 1;
             }
@@ -4446,7 +4459,6 @@ win32_process_message(HWND hwnd, UINT msg, WPARAM wParam, LPARAM lParam)
 #endif
 
         case WM_USER_KILL: {
-            dTHX;
             /* We use WM_USER_KILL to fake kill() with other signals */
             int sig = (int)wParam;
             if (do_raise(aTHX_ sig))
@@ -4456,7 +4468,6 @@ win32_process_message(HWND hwnd, UINT msg, WPARAM wParam, LPARAM lParam)
         }
 
         case WM_TIMER: {
-            dTHX;
             /* alarm() is a one-shot but SetTimer() repeats so kill it */
             if (w32_timerid && w32_timerid==(UINT)wParam) {
                 KillTimer(w32_message_hwnd, w32_timerid);