This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Use PerlMemShared for CopSTASHPV and CopFILE. MUCH harder than it sounds!
[perl5.git] / win32 / win32.c
index 687f121..40b7511 100644 (file)
@@ -7,7 +7,7 @@
  *    You may distribute under the terms of either the GNU General Public
  *    License or the Artistic License, as specified in the README file.
  */
-
+#define PERLIO_NOT_STDIO 0 
 #define WIN32_LEAN_AND_MEAN
 #define WIN32IO_IS_STDIO
 #include <tchar.h>
 #endif
 #include <winnt.h>
 #include <io.h>
+#include <signal.h>
 
 /* #include "config.h" */
 
-#define PERLIO_NOT_STDIO 0 
 #if !defined(PERLIO_IS_STDIO) && !defined(USE_SFIO)
 #define PerlIO FILE
 #endif
@@ -91,13 +91,6 @@ int _fcloseall();
 #  define getlogin g_getlogin
 #endif
 
-#if defined(PERL_OBJECT)
-#  undef do_aspawn
-#  define do_aspawn g_do_aspawn
-#  undef Perl_do_exec
-#  define Perl_do_exec g_do_exec
-#endif
-
 static void            get_shell(void);
 static long            tokenize(const char *str, char **dest, char ***destv);
        int             do_spawn2(char *cmd, int exectype);
@@ -179,7 +172,7 @@ get_regstr_from(HKEY hkey, const char *valuename, SV **svp)
        if (retval == ERROR_SUCCESS
            && (type == REG_SZ || type == REG_EXPAND_SZ))
        {
-           dTHXo;
+           dTHX;
            if (!*svp)
                *svp = sv_2mortal(newSVpvn("",0));
            SvGROW(*svp, datalen);
@@ -259,7 +252,7 @@ get_emd_part(SV **prev_pathp, char *trailing_path, ...)
     /* only add directory if it exists */
     if (GetFileAttributes(mod_name) != (DWORD) -1) {
        /* directory exists */
-       dTHXo;
+       dTHX;
        if (!*prev_pathp)
            *prev_pathp = sv_2mortal(newSVpvn("",0));
        sv_catpvn(*prev_pathp, ";", 1);
@@ -273,7 +266,7 @@ get_emd_part(SV **prev_pathp, char *trailing_path, ...)
 char *
 win32_get_privlib(const char *pl)
 {
-    dTHXo;
+    dTHX;
     char *stdlib = "lib";
     char buffer[MAX_PATH+1];
     SV *sv = Nullsv;
@@ -290,7 +283,7 @@ win32_get_privlib(const char *pl)
 static char *
 win32_get_xlib(const char *pl, const char *xlib, const char *libname)
 {
-    dTHXo;
+    dTHX;
     char regstr[40];
     char pathstr[MAX_PATH+1];
     DWORD datalen;
@@ -438,7 +431,7 @@ win32_getpid(void)
 {
     int pid;
 #ifdef USE_ITHREADS
-    dTHXo;
+    dTHX;
     if (w32_pseudo_id)
        return -((int)w32_pseudo_id);
 #endif
@@ -464,7 +457,7 @@ tokenize(const char *str, char **dest, char ***destv)
     char **retvstart = 0;
     int items = -1;
     if (str) {
-       dTHXo;
+       dTHX;
        int slen = strlen(str);
        register char *ret;
        register char **retv;
@@ -507,7 +500,7 @@ tokenize(const char *str, char **dest, char ***destv)
 static void
 get_shell(void)
 {
-    dTHXo;
+    dTHX;
     if (!w32_perlshell_tokens) {
        /* we don't use COMSPEC here for two reasons:
         *  1. the same reason perl on UNIX doesn't use SHELL--rampant and
@@ -528,7 +521,7 @@ get_shell(void)
 int
 do_aspawn(void *vreally, void **vmark, void **vsp)
 {
-    dTHXo;
+    dTHX;
     SV *really = (SV*)vreally;
     SV **mark = (SV**)vmark;
     SV **sp = (SV**)vsp;
@@ -593,10 +586,34 @@ do_aspawn(void *vreally, void **vmark, void **vsp)
     return (status);
 }
 
+/* returns pointer to the next unquoted space or the end of the string */
+static char*
+find_next_space(const char *s)
+{
+    bool in_quotes = FALSE;
+    while (*s) {
+       /* ignore doubled backslashes, or backslash+quote */
+       if (*s == '\\' && (s[1] == '\\' || s[1] == '"')) {
+           s += 2;
+       }
+       /* keep track of when we're within quotes */
+       else if (*s == '"') {
+           s++;
+           in_quotes = !in_quotes;
+       }
+       /* break it up only at spaces that aren't in quotes */
+       else if (!in_quotes && isSPACE(*s))
+           return (char*)s;
+       else
+           s++;
+    }
+    return (char*)s;
+}
+
 int
 do_spawn2(char *cmd, int exectype)
 {
-    dTHXo;
+    dTHX;
     char **a;
     char *s;
     char **argv;
@@ -616,8 +633,7 @@ do_spawn2(char *cmd, int exectype)
                s++;
            if (*s)
                *(a++) = s;
-           while (*s && !isSPACE(*s))
-               s++;
+           s = find_next_space(s);
            if (*s)
                *s++ = '\0';
        }
@@ -712,7 +728,7 @@ Perl_do_exec(pTHX_ char *cmd)
 DllExport DIR *
 win32_opendir(char *filename)
 {
-    dTHXo;
+    dTHX;
     DIR                        *dirp;
     long               len;
     long               idx;
@@ -824,7 +840,7 @@ win32_readdir(DIR *dirp)
        /* Now set up for the next call to readdir */
        dirp->curr += len + 1;
        if (dirp->curr >= dirp->end) {
-           dTHXo;
+           dTHX;
            char*               ptr;
            BOOL                res;
            WIN32_FIND_DATAW    wFindData;
@@ -898,7 +914,7 @@ win32_rewinddir(DIR *dirp)
 DllExport int
 win32_closedir(DIR *dirp)
 {
-    dTHXo;
+    dTHX;
     if (dirp->handle != INVALID_HANDLE_VALUE)
        FindClose(dirp->handle);
     Safefree(dirp->start);
@@ -960,7 +976,7 @@ setgid(gid_t agid)
 char *
 getlogin(void)
 {
-    dTHXo;
+    dTHX;
     char *buf = w32_getlogin_buffer;
     DWORD size = sizeof(w32_getlogin_buffer);
     if (GetUserName(buf,&size))
@@ -1003,7 +1019,7 @@ retry:
 static long
 find_pid(int pid)
 {
-    dTHXo;
+    dTHX;
     long child = w32_num_children;
     while (--child >= 0) {
        if (w32_child_pids[child] == pid)
@@ -1016,7 +1032,7 @@ static void
 remove_dead_process(long child)
 {
     if (child >= 0) {
-       dTHXo;
+       dTHX;
        CloseHandle(w32_child_handles[child]);
        Move(&w32_child_handles[child+1], &w32_child_handles[child],
             (w32_num_children-child-1), HANDLE);
@@ -1030,7 +1046,7 @@ remove_dead_process(long child)
 static long
 find_pseudo_pid(int pid)
 {
-    dTHXo;
+    dTHX;
     long child = w32_num_pseudo_children;
     while (--child >= 0) {
        if (w32_pseudo_child_pids[child] == pid)
@@ -1043,7 +1059,7 @@ static void
 remove_dead_pseudo_process(long child)
 {
     if (child >= 0) {
-       dTHXo;
+       dTHX;
        CloseHandle(w32_pseudo_child_handles[child]);
        Move(&w32_pseudo_child_handles[child+1], &w32_pseudo_child_handles[child],
             (w32_num_pseudo_children-child-1), HANDLE);
@@ -1057,7 +1073,7 @@ remove_dead_pseudo_process(long child)
 DllExport int
 win32_kill(int pid, int sig)
 {
-    dTHXo;
+    dTHX;
     HANDLE hProcess;
     long child;
 #ifdef USE_ITHREADS
@@ -1065,13 +1081,27 @@ win32_kill(int pid, int sig)
        /* it is a pseudo-forked child */
        child = find_pseudo_pid(-pid);
        if (child >= 0) {
-           if (!sig)
-               return 0;
            hProcess = w32_pseudo_child_handles[child];
-           if (TerminateThread(hProcess, sig)) {
-               remove_dead_pseudo_process(child);
+           switch (sig) {
+           case 0:
+               /* "Does process exist?" use of kill */
                return 0;
-           }
+           case 9:
+                /* kill -9 style un-graceful exit */
+               if (TerminateThread(hProcess, sig)) {
+                   remove_dead_pseudo_process(child);
+                   return 0;
+               }
+               break;
+           default:
+               /* We fake signals to pseudo-processes using Win32 message queue */
+               if (PostThreadMessage(-pid,WM_USER,sig,0)) {
+                   /* It might be us ... */ 
+                   PERL_ASYNC_CHECK();
+                   return 0;
+               }
+               break;
+            }
        }
        else if (IsWin95()) {
            pid = -pid;
@@ -1083,24 +1113,43 @@ win32_kill(int pid, int sig)
     {
        child = find_pid(pid);
        if (child >= 0) {
-           if (!sig)
-               return 0;
-           hProcess = w32_child_handles[child];
-           if (TerminateProcess(hProcess, sig)) {
-               remove_dead_process(child);
+            hProcess = w32_child_handles[child];
+           switch(sig) {
+           case 0:
+               /* "Does process exist?" use of kill */
                return 0;
-           }
+           case 2:
+               if (GenerateConsoleCtrlEvent(CTRL_C_EVENT,pid))
+                   return 0;
+               break;
+           default: /* For now be backwards compatible with perl5.6 */
+           case 9:
+               if (TerminateProcess(hProcess, sig)) {
+                   remove_dead_process(child);
+                   return 0;
+               }
+               break;
+            }
        }
        else {
 alien_process:
            hProcess = OpenProcess(PROCESS_ALL_ACCESS, TRUE,
                                   (IsWin95() ? -pid : pid));
            if (hProcess) {
-               if (!sig)
-                   return 0;
-               if (TerminateProcess(hProcess, sig)) {
-                   CloseHandle(hProcess);
+               switch(sig) {
+               case 0:
+                   /* "Does process exist?" use of kill */
                    return 0;
+               case 2:
+                   if (GenerateConsoleCtrlEvent(CTRL_C_EVENT,pid))
+                       return 0;
+                   break;
+               default: /* For now be backwards compatible with perl5.6 */
+                case 9:
+                   if (TerminateProcess(hProcess, sig)) {
+                       CloseHandle(hProcess);
+                       return 0;
+                   }
                }
            }
        }
@@ -1109,21 +1158,10 @@ alien_process:
     return -1;
 }
 
-/*
- * File system stuff
- */
-
-DllExport unsigned int
-win32_sleep(unsigned int t)
-{
-    Sleep(t*1000);
-    return 0;
-}
-
 DllExport int
 win32_stat(const char *path, struct stat *sbuf)
 {
-    dTHXo;
+    dTHX;
     char       buffer[MAX_PATH+1]; 
     int                l = strlen(path);
     int                res;
@@ -1325,7 +1363,7 @@ win32_longpath(char *path)
 DllExport char *
 win32_getenv(const char *name)
 {
-    dTHXo;
+    dTHX;
     WCHAR wBuffer[MAX_PATH+1];
     DWORD needlen;
     SV *curitem = Nullsv;
@@ -1374,7 +1412,7 @@ win32_getenv(const char *name)
 DllExport int
 win32_putenv(const char *name)
 {
-    dTHXo;
+    dTHX;
     char* curitem;
     char* val;
     WCHAR* wCuritem;
@@ -1483,7 +1521,7 @@ filetime_from_time(PFILETIME pFileTime, time_t Time)
 DllExport int
 win32_unlink(const char *filename)
 {
-    dTHXo;
+    dTHX;
     int ret;
     DWORD attrs;
 
@@ -1528,7 +1566,7 @@ fail:
 DllExport int
 win32_utime(const char *filename, struct utimbuf *times)
 {
-    dTHXo;
+    dTHX;
     HANDLE handle;
     FILETIME ftCreate;
     FILETIME ftAccess;
@@ -1674,25 +1712,187 @@ win32_uname(struct utsname *name)
     return 0;
 }
 
+/* Timing related stuff */
+
+DllExport int
+win32_async_check(pTHX)
+{
+    MSG msg;
+    int ours = 1;
+    /* Passing PeekMessage -1 as HWND (2nd arg) only get PostThreadMessage() messages
+     * and ignores window messages - should co-exist better with windows apps e.g. Tk
+     */ 
+    while (PeekMessage(&msg, (HWND)-1, 0, 0, PM_REMOVE|PM_NOYIELD)) {
+       switch(msg.message) {
+
+#if 0
+    /* Perhaps some other messages could map to signals ? ... */
+        case WM_CLOSE:
+        case WM_QUIT: 
+           /* Treat WM_QUIT like SIGHUP?  */
+           CALL_FPTR(PL_sighandlerp)(1);
+           break;
+#endif
+
+       /* We use WM_USER to fake kill() with other signals */
+       case WM_USER: {
+           CALL_FPTR(PL_sighandlerp)(msg.wParam);
+           break;
+       }
+       
+       case WM_TIMER: {
+           /* alarm() is a one-shot but SetTimer() repeats so kill it */
+           if (w32_timerid) {
+               KillTimer(NULL,w32_timerid);
+               w32_timerid=0;  
+            }
+           /* Now fake a call to signal handler */
+           CALL_FPTR(PL_sighandlerp)(14);
+           break;
+       }
+
+       /* Otherwise do normal Win32 thing - in case it is useful */
+       default:
+           TranslateMessage(&msg);
+           DispatchMessage(&msg);
+           ours = 0;
+           break;
+       }
+    }
+    w32_poll_count = 0;
+
+    /* Above or other stuff may have set a signal flag */
+    if (PL_sig_pending) {
+       despatch_signals();
+    }
+    return ours; 
+}
+
+DllExport DWORD
+win32_msgwait(pTHX_ DWORD count, LPHANDLE handles, DWORD timeout, LPDWORD resultp)
+{
+    /* We may need several goes at this - so compute when we stop */
+    DWORD ticks = 0;
+    if (timeout != INFINITE) {
+       ticks = GetTickCount();
+       timeout += ticks;
+    }
+    while (1) {
+       DWORD result = MsgWaitForMultipleObjects(count,handles,FALSE,timeout-ticks, QS_ALLEVENTS);
+       if (resultp)
+          *resultp = result;
+       if (result == WAIT_TIMEOUT) {
+           /* Ran out of time - explicit return of zero to avoid -ve if we 
+              have scheduling issues 
+             */        
+           return 0;
+       }
+       if (timeout != INFINITE) {
+           ticks = GetTickCount();
+        }
+       if (result == WAIT_OBJECT_0 + count) {
+           /* Message has arrived - check it */
+           if (win32_async_check(aTHX)) {
+               /* was one of ours */
+               break;
+           }
+       }
+       else {
+          /* Not timeout or message - one of handles is ready */
+          break;
+       }
+    }
+    /* compute time left to wait */
+    ticks = timeout - ticks;
+    /* If we are past the end say zero */
+    return (ticks > 0) ? ticks : 0;
+}
+
+int
+win32_internal_wait(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;
+
+#ifdef USE_ITHREADS
+    if (w32_num_pseudo_children) {
+       win32_msgwait(aTHX_ w32_num_pseudo_children, w32_pseudo_child_handles,
+                     timeout, &waitcode);
+        /* Time out here if there are no other children to wait for. */
+       if (waitcode == WAIT_TIMEOUT) {
+           if (!w32_num_children) {
+               return 0;
+           }
+       }
+       else if (waitcode != WAIT_FAILED) {
+           if (waitcode >= WAIT_ABANDONED_0
+               && waitcode < WAIT_ABANDONED_0 + w32_num_pseudo_children)
+               i = waitcode - WAIT_ABANDONED_0;
+           else
+               i = waitcode - WAIT_OBJECT_0;
+           if (GetExitCodeThread(w32_pseudo_child_handles[i], &exitcode)) {
+               *status = (int)((exitcode & 0xff) << 8);
+               retval = (int)w32_pseudo_child_pids[i];
+               remove_dead_pseudo_process(i);
+               return -retval;
+           }
+       }
+    }
+#endif
+
+    if (!w32_num_children) {
+       errno = ECHILD;
+       return -1;
+    }
+
+    /* if a child exists, wait for it to die */
+    win32_msgwait(aTHX_ w32_num_children, w32_child_handles, timeout, &waitcode);
+    if (waitcode == WAIT_TIMEOUT) {
+       return 0;
+    }
+    if (waitcode != WAIT_FAILED) {
+       if (waitcode >= WAIT_ABANDONED_0
+           && waitcode < WAIT_ABANDONED_0 + w32_num_children)
+           i = waitcode - WAIT_ABANDONED_0;
+       else
+           i = waitcode - WAIT_OBJECT_0;
+       if (GetExitCodeProcess(w32_child_handles[i], &exitcode) ) {
+           *status = (int)((exitcode & 0xff) << 8);
+           retval = (int)w32_child_pids[i];
+           remove_dead_process(i);
+           return retval;
+       }
+    }
+
+FAILED:
+    errno = GetLastError();
+    return -1;
+}
+
 DllExport int
 win32_waitpid(int pid, int *status, int flags)
 {
-    dTHXo;
+    dTHX;
     DWORD timeout = (flags & WNOHANG) ? 0 : INFINITE;
     int retval = -1;
     long child;
     if (pid == -1)                             /* XXX threadid == 1 ? */
-       return win32_wait(status);
+       return win32_internal_wait(status, timeout);
 #ifdef USE_ITHREADS
     else if (pid < 0) {
        child = find_pseudo_pid(-pid);
        if (child >= 0) {
            HANDLE hThread = w32_pseudo_child_handles[child];
-           DWORD waitcode = WaitForSingleObject(hThread, timeout);
+           DWORD waitcode;
+           win32_msgwait(aTHX_ 1, &hThread, timeout, &waitcode);
            if (waitcode == WAIT_TIMEOUT) {
                return 0;
            }
-           else if (waitcode != WAIT_FAILED) {
+           else if (waitcode == WAIT_OBJECT_0) {
                if (GetExitCodeThread(hThread, &waitcode)) {
                    *status = (int)((waitcode & 0xff) << 8);
                    retval = (int)w32_pseudo_child_pids[child];
@@ -1715,11 +1915,11 @@ win32_waitpid(int pid, int *status, int flags)
        child = find_pid(pid);
        if (child >= 0) {
            hProcess = w32_child_handles[child];
-           waitcode = WaitForSingleObject(hProcess, timeout);
+           win32_msgwait(aTHX_ 1, &hProcess, timeout, &waitcode);
            if (waitcode == WAIT_TIMEOUT) {
                return 0;
            }
-           else if (waitcode != WAIT_FAILED) {
+           else if (waitcode == WAIT_OBJECT_0) {
                if (GetExitCodeProcess(hProcess, &waitcode)) {
                    *status = (int)((waitcode & 0xff) << 8);
                    retval = (int)w32_child_pids[child];
@@ -1735,11 +1935,11 @@ alien_process:
            hProcess = OpenProcess(PROCESS_ALL_ACCESS, TRUE,
                                   (IsWin95() ? -pid : pid));
            if (hProcess) {
-               waitcode = WaitForSingleObject(hProcess, timeout);
+               win32_msgwait(aTHX_ 1, &hProcess, timeout, &waitcode);
                if (waitcode == WAIT_TIMEOUT) {
                    return 0;
                }
-               else if (waitcode != WAIT_FAILED) {
+               else if (waitcode == WAIT_OBJECT_0) {
                    if (GetExitCodeProcess(hProcess, &waitcode)) {
                        *status = (int)((waitcode & 0xff) << 8);
                        CloseHandle(hProcess);
@@ -1758,106 +1958,36 @@ alien_process:
 DllExport int
 win32_wait(int *status)
 {
-    /* XXX this wait emulation only knows about processes
-     * spawned via win32_spawnvp(P_NOWAIT, ...).
-     */
-    dTHXo;
-    int i, retval;
-    DWORD exitcode, waitcode;
-
-#ifdef USE_ITHREADS
-    if (w32_num_pseudo_children) {
-       waitcode = WaitForMultipleObjects(w32_num_pseudo_children,
-                                         w32_pseudo_child_handles,
-                                         FALSE,
-                                         INFINITE);
-       if (waitcode != WAIT_FAILED) {
-           if (waitcode >= WAIT_ABANDONED_0
-               && waitcode < WAIT_ABANDONED_0 + w32_num_pseudo_children)
-               i = waitcode - WAIT_ABANDONED_0;
-           else
-               i = waitcode - WAIT_OBJECT_0;
-           if (GetExitCodeThread(w32_pseudo_child_handles[i], &exitcode)) {
-               *status = (int)((exitcode & 0xff) << 8);
-               retval = (int)w32_pseudo_child_pids[i];
-               remove_dead_pseudo_process(i);
-               return -retval;
-           }
-       }
-    }
-#endif
-
-    if (!w32_num_children) {
-       errno = ECHILD;
-       return -1;
-    }
-
-    /* if a child exists, wait for it to die */
-    waitcode = WaitForMultipleObjects(w32_num_children,
-                                     w32_child_handles,
-                                     FALSE,
-                                     INFINITE);
-    if (waitcode != WAIT_FAILED) {
-       if (waitcode >= WAIT_ABANDONED_0
-           && waitcode < WAIT_ABANDONED_0 + w32_num_children)
-           i = waitcode - WAIT_ABANDONED_0;
-       else
-           i = waitcode - WAIT_OBJECT_0;
-       if (GetExitCodeProcess(w32_child_handles[i], &exitcode) ) {
-           *status = (int)((exitcode & 0xff) << 8);
-           retval = (int)w32_child_pids[i];
-           remove_dead_process(i);
-           return retval;
-       }
-    }
-
-FAILED:
-    errno = GetLastError();
-    return -1;
+    return win32_internal_wait(status, INFINITE);
 }
 
-#ifndef PERL_OBJECT
-
-static UINT timerid = 0;
-
-static VOID CALLBACK TimerProc(HWND win, UINT msg, UINT id, DWORD time)
+DllExport unsigned int
+win32_sleep(unsigned int t)
 {
-    dTHXo;
-    KillTimer(NULL,timerid);
-    timerid=0;  
-    CALL_FPTR(PL_sighandlerp)(14);
+    dTHX;
+    /* Win32 times are in ms so *1000 in and /1000 out */
+    return win32_msgwait(aTHX_ 0, NULL, t*1000, NULL)/1000;
 }
-#endif /* !PERL_OBJECT */
 
 DllExport unsigned int
 win32_alarm(unsigned int sec)
 {
-#ifndef PERL_OBJECT
     /* 
      * the 'obvious' implentation is SetTimer() with a callback
      * which does whatever receiving SIGALRM would do 
      * we cannot use SIGALRM even via raise() as it is not 
      * one of the supported codes in <signal.h>
-     *
-     * Snag is unless something is looking at the message queue
-     * nothing happens :-(
      */ 
-    dTHXo;
-    if (sec)
-     {
-      timerid = SetTimer(NULL,timerid,sec*1000,(TIMERPROC)TimerProc);
-      if (!timerid)
-       Perl_croak_nocontext("Cannot set timer");
-     } 
-    else
-     {
-      if (timerid)
-       {
-        KillTimer(NULL,timerid);
-        timerid=0;  
-       }
-     }
-#endif /* !PERL_OBJECT */
+    dTHX;
+    if (sec) {
+       w32_timerid = SetTimer(NULL,w32_timerid,sec*1000,NULL);
+    }
+    else {
+       if (w32_timerid) {
+            KillTimer(NULL,w32_timerid);
+           w32_timerid=0;  
+       }
+    }  
     return 0;
 }
 
@@ -1868,7 +1998,7 @@ extern char *     des_fcrypt(const char *txt, const char *salt, char *cbuf);
 DllExport char *
 win32_crypt(const char *txt, const char *salt)
 {
-    dTHXo;
+    dTHX;
 #ifdef HAVE_DES_FCRYPT
     return des_fcrypt(txt, salt, w32_crypt_buffer);
 #else
@@ -1980,7 +2110,7 @@ win32_flock(int fd, int oper)
     HANDLE fh;
 
     if (!IsWinNT()) {
-       dTHXo;
+       dTHX;
        Perl_croak_nocontext("flock() unimplemented on this platform");
        return -1;
     }
@@ -2079,7 +2209,7 @@ win32_strerror(int e)
     DWORD source = 0;
 
     if (e < 0 || e > sys_nerr) {
-        dTHXo;
+        dTHX;
        if (e < 0)
            e = GetLastError();
 
@@ -2119,7 +2249,7 @@ win32_str_os_error(void *sv, DWORD dwErr)
                            dwErr, GetLastError());
     }
     if (sMsg) {
-       dTHXo;
+       dTHX;
        sv_setpvn((SV*)sv, sMsg, dwLen);
        LocalFree(sMsg);
     }
@@ -2172,7 +2302,7 @@ win32_fwrite(const void *buf, size_t size, size_t count, FILE *fp)
 DllExport FILE *
 win32_fopen(const char *filename, const char *mode)
 {
-    dTHXo;
+    dTHX;
     WCHAR wMode[MODE_SIZE], wBuffer[MAX_PATH+1];
     FILE *f;
     
@@ -2203,7 +2333,7 @@ win32_fopen(const char *filename, const char *mode)
 DllExport FILE *
 win32_fdopen(int handle, const char *mode)
 {
-    dTHXo;
+    dTHX;
     WCHAR wMode[MODE_SIZE];
     FILE *f;
     if (USING_WIDE()) {
@@ -2221,7 +2351,7 @@ win32_fdopen(int handle, const char *mode)
 DllExport FILE *
 win32_freopen(const char *path, const char *mode, FILE *stream)
 {
-    dTHXo;
+    dTHX;
     WCHAR wMode[MODE_SIZE], wBuffer[MAX_PATH+1];
     if (stricmp(path, "/dev/null")==0)
        path = "NUL";
@@ -2317,7 +2447,31 @@ win32_rewind(FILE *pf)
 DllExport FILE*
 win32_tmpfile(void)
 {
-    return tmpfile();
+    dTHX;
+    char prefix[MAX_PATH+1];
+    char filename[MAX_PATH+1];
+    DWORD len = GetTempPath(MAX_PATH, prefix);
+    if (len && len < MAX_PATH) {
+       if (GetTempFileName(prefix, "plx", 0, filename)) {
+           HANDLE fh = CreateFile(filename,
+                                  DELETE | GENERIC_READ | GENERIC_WRITE,
+                                  0,
+                                  NULL,
+                                  CREATE_ALWAYS,
+                                  FILE_ATTRIBUTE_NORMAL
+                                  | FILE_FLAG_DELETE_ON_CLOSE,
+                                  NULL);
+           if (fh != INVALID_HANDLE_VALUE) {
+               int fd = win32_open_osfhandle((long)fh, 0);
+               if (fd >= 0) {
+                   DEBUG_p(PerlIO_printf(Perl_debug_log,
+                                         "Created tmpfile=%s\n",filename));
+                   return fdopen(fd, "w+b");
+               }
+           }
+       }
+    }
+    return NULL;
 }
 
 DllExport void
@@ -2425,7 +2579,7 @@ win32_popen(const char *command, const char *mode)
 
     /* start the child */
     {
-       dTHXo;
+       dTHX;
        if ((childpid = do_spawn_nowait((char*)command)) == -1)
            goto cleanup;
 
@@ -2470,7 +2624,7 @@ win32_pclose(PerlIO *pf)
 #ifdef USE_RTL_POPEN
     return _pclose(pf);
 #else
-    dTHXo;
+    dTHX;
     int childpid, status;
     SV *sv;
 
@@ -2564,7 +2718,7 @@ Nt4CreateHardLinkW(
 DllExport int
 win32_link(const char *oldname, const char *newname)
 {
-    dTHXo;
+    dTHX;
     BOOL (__stdcall *pfnCreateHardLinkW)(LPCWSTR,LPCWSTR,LPSECURITY_ATTRIBUTES);
     WCHAR wOldName[MAX_PATH+1];
     WCHAR wNewName[MAX_PATH+1];
@@ -2597,7 +2751,7 @@ win32_rename(const char *oname, const char *newname)
     char szOldName[MAX_PATH+1];
     char szNewName[MAX_PATH+1];
     BOOL bResult;
-    dTHXo;
+    dTHX;
 
     /* XXX despite what the documentation says about MoveFileEx(),
      * it doesn't work under Windows95!
@@ -2735,7 +2889,7 @@ win32_tell(int fd)
 DllExport int
 win32_open(const char *path, int flag, ...)
 {
-    dTHXo;
+    dTHX;
     va_list ap;
     int pmode;
     WCHAR wBuffer[MAX_PATH+1];
@@ -2996,7 +3150,7 @@ win32_write(int fd, const void *buf, unsigned int cnt)
 DllExport int
 win32_mkdir(const char *dir, int mode)
 {
-    dTHXo;
+    dTHX;
     if (USING_WIDE()) {
        WCHAR wBuffer[MAX_PATH+1];
        A2WHELPER(dir, wBuffer, sizeof(wBuffer));
@@ -3008,7 +3162,7 @@ win32_mkdir(const char *dir, int mode)
 DllExport int
 win32_rmdir(const char *dir)
 {
-    dTHXo;
+    dTHX;
     if (USING_WIDE()) {
        WCHAR wBuffer[MAX_PATH+1];
        A2WHELPER(dir, wBuffer, sizeof(wBuffer));
@@ -3020,7 +3174,11 @@ win32_rmdir(const char *dir)
 DllExport int
 win32_chdir(const char *dir)
 {
-    dTHXo;
+    dTHX;
+    if (!dir) {
+       errno = ENOENT;
+       return -1;
+    }
     if (USING_WIDE()) {
        WCHAR wBuffer[MAX_PATH+1];
        A2WHELPER(dir, wBuffer, sizeof(wBuffer));
@@ -3032,7 +3190,7 @@ win32_chdir(const char *dir)
 DllExport  int
 win32_access(const char *path, int mode)
 {
-    dTHXo;
+    dTHX;
     if (USING_WIDE()) {
        WCHAR wBuffer[MAX_PATH+1];
        A2WHELPER(path, wBuffer, sizeof(wBuffer));
@@ -3044,7 +3202,7 @@ win32_access(const char *path, int mode)
 DllExport  int
 win32_chmod(const char *path, int mode)
 {
-    dTHXo;
+    dTHX;
     if (USING_WIDE()) {
        WCHAR wBuffer[MAX_PATH+1];
        A2WHELPER(path, wBuffer, sizeof(wBuffer));
@@ -3055,33 +3213,162 @@ win32_chmod(const char *path, int mode)
 
 
 static char *
-create_command_line(const char* command, const char * const *args)
+create_command_line(char *cname, STRLEN clen, const char * const *args)
 {
-    dTHXo;
-    int index;
-    char *cmd, *ptr, *arg;
-    STRLEN len = strlen(command) + 1;
+    dTHX;
+    int index, argc;
+    char *cmd, *ptr;
+    const char *arg;
+    STRLEN len = 0;
+    bool bat_file = FALSE;
+    bool cmd_shell = FALSE;
+    bool dumb_shell = FALSE;
+    bool extra_quotes = FALSE;
+    bool quote_next = FALSE;
+
+    if (!cname)
+       cname = (char*)args[0];
+
+    /* The NT cmd.exe shell has the following peculiarity that needs to be
+     * worked around.  It strips a leading and trailing dquote when any
+     * of the following is true:
+     *    1. the /S switch was used
+     *    2. there are more than two dquotes
+     *    3. there is a special character from this set: &<>()@^|
+     *    4. no whitespace characters within the two dquotes
+     *    5. string between two dquotes isn't an executable file
+     * To work around this, we always add a leading and trailing dquote
+     * to the string, if the first argument is either "cmd.exe" or "cmd",
+     * and there were at least two or more arguments passed to cmd.exe
+     * (not including switches).
+     * XXX the above rules (from "cmd /?") don't seem to be applied
+     * always, making for the convolutions below :-(
+     */
+    if (cname) {
+       if (!clen)
+           clen = strlen(cname);
+
+       if (clen > 4
+           && (stricmp(&cname[clen-4], ".bat") == 0
+               || (IsWinNT() && stricmp(&cname[clen-4], ".cmd") == 0)))
+       {
+           bat_file = TRUE;
+           len += 3;
+       }
+       else {
+           char *exe = strrchr(cname, '/');
+           char *exe2 = strrchr(cname, '\\');
+           if (exe2 > exe)
+               exe = exe2;
+           if (exe)
+               ++exe;
+           else
+               exe = cname;
+           if (stricmp(exe, "cmd.exe") == 0 || stricmp(exe, "cmd") == 0) {
+               cmd_shell = TRUE;
+               len += 3;
+           }
+           else if (stricmp(exe, "command.com") == 0
+                    || stricmp(exe, "command") == 0)
+           {
+               dumb_shell = TRUE;
+           }
+       }
+    }
 
-    for (index = 0; (ptr = (char*)args[index]) != NULL; ++index)
-       len += strlen(ptr) + 1;
+    DEBUG_p(PerlIO_printf(Perl_debug_log, "Args "));
+    for (index = 0; (arg = (char*)args[index]) != NULL; ++index) {
+       STRLEN curlen = strlen(arg);
+       if (!(arg[0] == '"' && arg[curlen-1] == '"'))
+           len += 2;   /* assume quoting needed (worst case) */
+       len += curlen + 1;
+       DEBUG_p(PerlIO_printf(Perl_debug_log, "[%s]",arg));
+    }
+    DEBUG_p(PerlIO_printf(Perl_debug_log, "\n"));
 
+    argc = index;
     New(1310, cmd, len, char);
     ptr = cmd;
-    strcpy(ptr, command);
+
+    if (bat_file) {
+       *ptr++ = '"';
+       extra_quotes = TRUE;
+    }
 
     for (index = 0; (arg = (char*)args[index]) != NULL; ++index) {
-       ptr += strlen(ptr);
-       *ptr++ = ' ';
+       bool do_quote = 0;
+       STRLEN curlen = strlen(arg);
+
+       /* we want to protect empty arguments and ones with spaces with
+        * dquotes, but only if they aren't already there */
+       if (!dumb_shell) {
+           if (!curlen) {
+               do_quote = 1;
+           }
+           else if (quote_next) {
+               /* see if it really is multiple arguments pretending to
+                * be one and force a set of quotes around it */
+               if (*find_next_space(arg))
+                   do_quote = 1;
+           }
+           else if (!(arg[0] == '"' && curlen > 1 && arg[curlen-1] == '"')) {
+               STRLEN i = 0;
+               while (i < curlen) {
+                   if (isSPACE(arg[i])) {
+                       do_quote = 1;
+                   }
+                   else if (arg[i] == '"') {
+                       do_quote = 0;
+                       break;
+                   }
+                   i++;
+               }
+           }
+       }
+
+       if (do_quote)
+           *ptr++ = '"';
+
        strcpy(ptr, arg);
+       ptr += curlen;
+
+       if (do_quote)
+           *ptr++ = '"';
+
+       if (args[index+1])
+           *ptr++ = ' ';
+
+       if (!extra_quotes
+           && cmd_shell
+           && (stricmp(arg, "/x/c") == 0 || stricmp(arg, "/c") == 0))
+       {
+           /* is there a next argument? */
+           if (args[index+1]) {
+               /* are there two or more next arguments? */
+               if (args[index+2]) {
+                   *ptr++ = '"';
+                   extra_quotes = TRUE;
+               }
+               else {
+                   /* single argument, force quoting if it has spaces */
+                   quote_next = TRUE;
+               }
+           }
+       }
     }
 
+    if (extra_quotes)
+       *ptr++ = '"';
+
+    *ptr = '\0';
+
     return cmd;
 }
 
 static char *
 qualified_path(const char *cmd)
 {
-    dTHXo;
+    dTHX;
     char *pathstr;
     char *fullcmd, *curfullcmd;
     STRLEN cmdlen = 0;
@@ -3172,21 +3459,41 @@ GIVE_UP:
  * environment and the current directory to CreateProcess
  */
 
-void*
-get_childenv(void)
+DllExport void*
+win32_get_childenv(void)
 {
     return NULL;
 }
 
-void
-free_childenv(void* d)
+DllExport void
+win32_free_childenv(void* d)
+{
+}
+
+DllExport void
+win32_clearenv(void)
 {
+    char *envv = GetEnvironmentStrings();
+    char *cur = envv;
+    STRLEN len;
+    while (*cur) {
+       char *end = strchr(cur,'=');
+       if (end && end != cur) {
+           *end = '\0';
+           SetEnvironmentVariable(cur, NULL);
+           *end = '=';
+           cur = end + strlen(end+1)+2;
+       }
+       else if ((len = strlen(cur)))
+           cur += len+1;
+    }
+    FreeEnvironmentStrings(envv);
 }
 
-char*
-get_childdir(void)
+DllExport char*
+win32_get_childdir(void)
 {
-    dTHXo;
+    dTHX;
     char* ptr;
     char szfilename[(MAX_PATH+1)*2];
     if (USING_WIDE()) {
@@ -3203,10 +3510,10 @@ get_childdir(void)
     return ptr;
 }
 
-void
-free_childdir(char* d)
+DllExport void
+win32_free_childdir(char* d)
 {
-    dTHXo;
+    dTHX;
     Safefree(d);
 }
 
@@ -3228,7 +3535,7 @@ win32_spawnvp(int mode, const char *cmdname, const char *const *argv)
 #ifdef USE_RTL_SPAWNVP
     return spawnvp(mode, cmdname, (char * const *)argv);
 #else
-    dTHXo;
+    dTHX;
     int ret;
     void* env;
     char* dir;
@@ -3236,10 +3543,30 @@ win32_spawnvp(int mode, const char *cmdname, const char *const *argv)
     STARTUPINFO StartupInfo;
     PROCESS_INFORMATION ProcessInformation;
     DWORD create = 0;
-
-    char *cmd = create_command_line(cmdname, strcmp(cmdname, argv[0]) == 0
-                                            ? &argv[1] : argv);
+    char *cmd;
     char *fullcmd = Nullch;
+    char *cname = (char *)cmdname;
+    STRLEN clen = 0;
+
+    if (cname) {
+       clen = strlen(cname);
+       /* if command name contains dquotes, must remove them */
+       if (strchr(cname, '"')) {
+           cmd = cname;
+           New(0,cname,clen+1,char);
+           clen = 0;
+           while (*cmd) {
+               if (*cmd != '"') {
+                   cname[clen] = *cmd;
+                   ++clen;
+               }
+               ++cmd;
+           }
+           cname[clen] = '\0';
+       }
+    }
+
+    cmd = create_command_line(cname, clen, argv);
 
     env = PerlEnv_get_childenv();
     dir = PerlEnv_get_childdir();
@@ -3251,7 +3578,12 @@ win32_spawnvp(int mode, const char *cmdname, const char *const *argv)
            ret = -1;
            goto RETVAL;
        }
+       /* Create a new process group so we can use GenerateConsoleCtrlEvent() 
+        * in win32_kill()
+        */
+        create |= CREATE_NEW_PROCESS_GROUP;  
        /* FALL THROUGH */
+
     case P_WAIT:       /* synchronous execution */
        break;
     default:           /* invalid mode */
@@ -3285,8 +3617,10 @@ win32_spawnvp(int mode, const char *cmdname, const char *const *argv)
        create |= CREATE_NEW_CONSOLE;
     }
 
+    DEBUG_p(PerlIO_printf(Perl_debug_log, "Spawning [%s] with [%s]\n",
+                         cname,cmd));
 RETRY:
-    if (!CreateProcess(cmdname,                /* search PATH to find executable */
+    if (!CreateProcess(cname,          /* search PATH to find executable */
                       cmd,             /* executable, and its arguments */
                       NULL,            /* process attributes */
                       NULL,            /* thread attributes */
@@ -3304,9 +3638,14 @@ RETRY:
         * jump through our own hoops by picking out the path
         * we really want it to use. */
        if (!fullcmd) {
-           fullcmd = qualified_path(cmdname);
+           fullcmd = qualified_path(cname);
            if (fullcmd) {
-               cmdname = fullcmd;
+               if (cname != cmdname)
+                   Safefree(cname);
+               cname = fullcmd;
+               DEBUG_p(PerlIO_printf(Perl_debug_log,
+                                     "Retrying [%s] with same args\n",
+                                     cname));
                goto RETRY;
            }
        }
@@ -3327,7 +3666,10 @@ RETRY:
     }
     else  {
        DWORD status;
-       WaitForSingleObject(ProcessInformation.hProcess, INFINITE);
+       win32_msgwait(aTHX_ 1, &ProcessInformation.hProcess, INFINITE, NULL);
+       /* FIXME: if msgwait returned due to message perhaps forward the
+          "signal" to the process
+         */
        GetExitCodeProcess(ProcessInformation.hProcess, &status);
        ret = (int)status;
        CloseHandle(ProcessInformation.hProcess);
@@ -3339,7 +3681,8 @@ RETVAL:
     PerlEnv_free_childenv(env);
     PerlEnv_free_childdir(dir);
     Safefree(cmd);
-    Safefree(fullcmd);
+    if (cname != cmdname)
+       Safefree(cname);
     return ret;
 #endif
 }
@@ -3348,7 +3691,7 @@ DllExport int
 win32_execv(const char *cmdname, const char *const *argv)
 {
 #ifdef USE_ITHREADS
-    dTHXo;
+    dTHX;
     /* if this is a pseudo-forked child, we just want to spawn
      * the new program, and return */
     if (w32_pseudo_id)
@@ -3361,7 +3704,7 @@ DllExport int
 win32_execvp(const char *cmdname, const char *const *argv)
 {
 #ifdef USE_ITHREADS
-    dTHXo;
+    dTHX;
     /* if this is a pseudo-forked child, we just want to spawn
      * the new program, and return */
     if (w32_pseudo_id) {
@@ -3453,12 +3796,12 @@ win32_putchar(int c)
 
 #ifndef USE_PERL_SBRK
 
-static char *committed = NULL;
-static char *base      = NULL;
-static char *reserved  = NULL;
-static char *brk       = NULL;
-static DWORD pagesize  = 0;
-static DWORD allocsize = 0;
+static char *committed = NULL;         /* XXX threadead */
+static char *base      = NULL;         /* XXX threadead */
+static char *reserved  = NULL;         /* XXX threadead */
+static char *brk       = NULL;         /* XXX threadead */
+static DWORD pagesize  = 0;            /* XXX threadead */
+static DWORD allocsize = 0;            /* XXX threadead */
 
 void *
 sbrk(int need)
@@ -3572,7 +3915,7 @@ win32_get_osfhandle(int fd)
 DllExport void*
 win32_dynaload(const char* filename)
 {
-    dTHXo;
+    dTHX;
     HMODULE hModule;
     char buf[MAX_PATH+1];
     char *first;
@@ -3624,6 +3967,10 @@ XS(w32_GetCwd)
        sv_setpv(sv, ptr);
        PerlEnv_free_childdir(ptr);
 
+#ifndef INCOMPLETE_TAINTS
+       SvTAINTED_on(sv);
+#endif
+
        EXTEND(SP,1);
        SvPOK_on(sv);
        ST(0) = sv;
@@ -4065,7 +4412,7 @@ XS(w32_CopyFile)
 void
 Perl_init_os_extras(void)
 {
-    dTHXo;
+    dTHX;
     char *file = __FILE__;
     dXSUB_SYS;
 
@@ -4103,6 +4450,66 @@ Perl_init_os_extras(void)
      */
 }
 
+PerlInterpreter *
+win32_signal_context(void)
+{
+    dTHX;
+    if (!my_perl) {
+       my_perl = PL_curinterp;
+       PERL_SET_THX(my_perl);
+    } 
+    return my_perl;
+}
+
+BOOL WINAPI 
+win32_ctrlhandler(DWORD dwCtrlType)
+{
+    dTHXa(PERL_GET_SIG_CONTEXT);
+
+    if (!my_perl)
+       return FALSE;
+
+    switch(dwCtrlType) {
+    case CTRL_CLOSE_EVENT:
+     /*  A signal that the system sends to all processes attached to a console when 
+         the user closes the console (either by choosing the Close command from the 
+         console window's System menu, or by choosing the End Task command from the 
+         Task List
+      */
+       CALL_FPTR(PL_sighandlerp)(1); /* SIGHUP */
+       return TRUE;    
+
+    case CTRL_C_EVENT:
+       /*  A CTRL+c signal was received */
+       CALL_FPTR(PL_sighandlerp)(SIGINT); /* SIGINT */
+       return TRUE;    
+
+    case CTRL_BREAK_EVENT:
+       /*  A CTRL+BREAK signal was received */
+       CALL_FPTR(PL_sighandlerp)(SIGBREAK); /* unix calls it SIGQUIT */
+       return TRUE;    
+
+    case CTRL_LOGOFF_EVENT:
+      /*  A signal that the system sends to all console processes when a user is logging 
+          off. This signal does not indicate which user is logging off, so no 
+          assumptions can be made. 
+       */
+       break;  
+    case CTRL_SHUTDOWN_EVENT:
+      /*  A signal that the system sends to all console processes when the system is 
+          shutting down. 
+       */
+       CALL_FPTR(PL_sighandlerp)(SIGTERM); 
+       return TRUE;    
+       break;  
+    default:
+       break;  
+    }
+    return FALSE;
+}
+
+
 void
 Perl_win32_init(int *argcp, char ***argvp)
 {
@@ -4128,15 +4535,16 @@ win32_get_child_IO(child_IO_table* ptbl)
 
 #ifdef HAVE_INTERP_INTERN
 
-#  ifdef PERL_OBJECT
-#    undef Perl_sys_intern_init
-#    define Perl_sys_intern_init CPerlObj::Perl_sys_intern_init
-#    undef Perl_sys_intern_dup
-#    define Perl_sys_intern_dup CPerlObj::Perl_sys_intern_dup
-#    undef Perl_sys_intern_clear
-#    define Perl_sys_intern_clear CPerlObj::Perl_sys_intern_clear
-#    define pPerl this
-#  endif
+
+static void
+win32_csighandler(int sig)
+{
+#if 0
+    dTHXa(PERL_GET_SIG_CONTEXT);
+    Perl_warn(aTHX_ "Got signal %d",sig);
+#endif
+    /* Does nothing */
+}
 
 void
 Perl_sys_intern_init(pTHX)
@@ -4153,6 +4561,15 @@ Perl_sys_intern_init(pTHX)
     w32_num_pseudo_children    = 0;
 #  endif
     w32_init_socktype          = 0;
+    w32_timerid                 = 0;
+    w32_poll_count              = 0;
+    if (my_perl == PL_curinterp) {
+        /* Force C runtime signal stuff to set its console handler */
+       signal(SIGINT,&win32_csighandler);
+       signal(SIGBREAK,&win32_csighandler);
+        /* Push our handler on top */
+       SetConsoleCtrlHandler(win32_ctrlhandler,TRUE);
+    }
 }
 
 void
@@ -4162,6 +4579,13 @@ Perl_sys_intern_clear(pTHX)
     Safefree(w32_perlshell_vec);
     /* NOTE: w32_fdpid is freed by sv_clean_all() */
     Safefree(w32_children);
+    if (w32_timerid) {
+       KillTimer(NULL,w32_timerid);
+       w32_timerid=0;  
+    }
+    if (my_perl == PL_curinterp) {
+       SetConsoleCtrlHandler(win32_ctrlhandler,FALSE);
+    }
 #  ifdef USE_ITHREADS
     Safefree(w32_pseudo_children);
 #  endif
@@ -4180,17 +4604,14 @@ Perl_sys_intern_dup(pTHX_ struct interp_intern *src, struct interp_intern *dst)
     dst->pseudo_id             = 0;
     Newz(1313, dst->pseudo_children, 1, child_tab);
     dst->thr_intern.Winit_socktype = 0;
+    dst->timerid                 = 0;
+    dst->poll_count              = 0;
 }
 #  endif /* USE_ITHREADS */
 #endif /* HAVE_INTERP_INTERN */
 
-#ifdef PERL_OBJECT
-#  undef this
-#  define this pPerl
-#endif
-
 static void
-win32_free_argvw(pTHXo_ void *ptr)
+win32_free_argvw(pTHX_ void *ptr)
 {
     char** argv = (char**)ptr;
     while(*argv) {
@@ -4202,7 +4623,7 @@ win32_free_argvw(pTHXo_ void *ptr)
 void
 win32_argv2utf8(int argc, char** argv)
 {
-    dTHXo;
+    dTHX;
     char* psz;
     int length, wargc;
     LPWSTR* lpwStr = CommandLineToArgvW(GetCommandLineW(), &wargc);
@@ -4218,3 +4639,6 @@ win32_argv2utf8(int argc, char** argv)
     GlobalFree((HGLOBAL)lpwStr);
 }
 
+
+
+