applied patch, with indentation tweaks
[p5sagit/p5-mst-13.2.git] / win32 / win32.c
index 9d819b5..b22ec8a 100644 (file)
 #include <tchar.h>
 #ifdef __GNUC__
 #define Win32_Winsock
+#  ifdef __cplusplus
+#undef __attribute__           /* seems broken in 2.8.0 */
+#define __attribute__(p)
+#  endif
 #endif
 #include <windows.h>
 
+#ifndef __MINGW32__
+#include <lmcons.h>
+#include <lmerr.h>
+/* ugliness to work around a buggy struct definition in lmwksta.h */
+#undef LPTSTR
+#define LPTSTR LPWSTR
+#include <lmwksta.h>
+#undef LPTSTR
+#define LPTSTR LPSTR
+#include <lmapibuf.h>
+#endif /* __MINGW32__ */
+
 /* #include "config.h" */
 
 #define PERLIO_NOT_STDIO 0 
 
 #include "EXTERN.h"
 #include "perl.h"
+
+#define NO_XSLOCKS
+#ifdef PERL_OBJECT
+extern CPerlObj* pPerl;
+#endif
 #include "XSUB.h"
+
+#include "Win32iop.h"
 #include <fcntl.h>
 #include <sys/stat.h>
 #ifndef __GNUC__
@@ -53,42 +76,65 @@ int _CRT_glob = 0;
 #define EXECF_SPAWN 2
 #define EXECF_SPAWN_NOWAIT 3
 
+#if defined(PERL_OBJECT)
+#undef win32_get_privlib
+#define win32_get_privlib g_win32_get_privlib
+#undef win32_get_sitelib
+#define win32_get_sitelib g_win32_get_sitelib
+#undef do_aspawn
+#define do_aspawn g_do_aspawn
+#undef do_spawn
+#define do_spawn g_do_spawn
+#undef do_exec
+#define do_exec g_do_exec
+#undef opendir
+#define opendir g_opendir
+#undef readdir
+#define readdir g_readdir
+#undef telldir
+#define telldir g_telldir
+#undef seekdir
+#define seekdir g_seekdir
+#undef rewinddir
+#define rewinddir g_rewinddir
+#undef closedir
+#define closedir g_closedir
+#undef getlogin
+#define getlogin g_getlogin
+#endif
+
 static DWORD           os_id(void);
 static void            get_shell(void);
 static long            tokenize(char *str, char **dest, char ***destv);
-static int             do_spawn2(char *cmd, int exectype);
+       int             do_spawn2(char *cmd, int exectype);
 static BOOL            has_redirection(char *ptr);
 static long            filetime_to_clock(PFILETIME ft);
 static BOOL            filetime_from_time(PFILETIME ft, time_t t);
+static char *          get_emd_part(char *leading, char *trailing, ...);
 
-char * w32_perlshell_tokens = Nullch;
-char **        w32_perlshell_vec;
-long   w32_perlshell_items = -1;
-DWORD  w32_platform = (DWORD)-1;
-char   w32_perllib_root[MAX_PATH+1];
 HANDLE w32_perldll_handle = INVALID_HANDLE_VALUE;
-#ifndef __BORLANDC__
-long   w32_num_children = 0;
-HANDLE w32_child_pids[MAXIMUM_WAIT_OBJECTS];
-#endif
+static DWORD   w32_platform = (DWORD)-1;
 
 #ifdef USE_THREADS
 #  ifdef USE_DECLSPEC_THREAD
 __declspec(thread) char        strerror_buffer[512];
 __declspec(thread) char        getlogin_buffer[128];
+__declspec(thread) char        w32_perllib_root[MAX_PATH+1];
 #    ifdef HAVE_DES_FCRYPT
 __declspec(thread) char        crypt_buffer[30];
 #    endif
 #  else
 #    define strerror_buffer    (thr->i.Wstrerror_buffer)
 #    define getlogin_buffer    (thr->i.Wgetlogin_buffer)
+#    define w32_perllib_root   (thr->i.Ww32_perllib_root)
 #    define crypt_buffer       (thr->i.Wcrypt_buffer)
 #  endif
 #else
-char   strerror_buffer[512];
-char   getlogin_buffer[128];
+static char    strerror_buffer[512];
+static char    getlogin_buffer[128];
+static char    w32_perllib_root[MAX_PATH+1];
 #  ifdef HAVE_DES_FCRYPT
-char   crypt_buffer[30];
+static char    crypt_buffer[30];
 #  endif
 #endif
 
@@ -102,29 +148,156 @@ IsWinNT(void) {
     return (os_id() == VER_PLATFORM_WIN32_NT);
 }
 
-char *
-win32_perllib_path(char *sfx,...)
+char*
+GetRegStrFromKey(HKEY hkey, const char *lpszValueName, char** ptr, DWORD* lpDataLen)
+{   /* Retrieve a REG_SZ or REG_EXPAND_SZ from the registry */
+    HKEY handle;
+    DWORD type;
+    const char *subkey = "Software\\Perl";
+    long retval;
+
+    retval = RegOpenKeyEx(hkey, subkey, 0, KEY_READ, &handle);
+    if (retval == ERROR_SUCCESS){
+       retval = RegQueryValueEx(handle, lpszValueName, 0, &type, NULL, lpDataLen);
+       if (retval == ERROR_SUCCESS && type == REG_SZ) {
+           if (*ptr != NULL) {
+               Renew(*ptr, *lpDataLen, char);
+           }
+           else {
+               New(1312, *ptr, *lpDataLen, char);
+           }
+           retval = RegQueryValueEx(handle, lpszValueName, 0, NULL, (PBYTE)*ptr, lpDataLen);
+           if (retval != ERROR_SUCCESS) {
+               Safefree(*ptr);
+               *ptr = NULL;
+           }
+       }
+       RegCloseKey(handle);
+    }
+    return *ptr;
+}
+
+char*
+GetRegStr(const char *lpszValueName, char** ptr, DWORD* lpDataLen)
+{
+    *ptr = GetRegStrFromKey(HKEY_CURRENT_USER, lpszValueName, ptr, lpDataLen);
+    if (*ptr == NULL)
+    {
+       *ptr = GetRegStrFromKey(HKEY_LOCAL_MACHINE, lpszValueName, ptr, lpDataLen);
+    }
+    return *ptr;
+}
+
+static char *
+get_emd_part(char *prev_path, char *trailing_path, ...)
 {
     va_list ap;
-    char *end;
-    va_start(ap,sfx);
-    GetModuleFileName((w32_perldll_handle == INVALID_HANDLE_VALUE) 
-                     ? GetModuleHandle(NULL)
-                     : w32_perldll_handle,
-                     w32_perllib_root, 
-                     sizeof(w32_perllib_root));
-    *(end = strrchr(w32_perllib_root, '\\')) = '\0';
-    if (stricmp(end-4,"\\bin") == 0)
-     end -= 4;
-    strcpy(end,"\\lib");
-    while (sfx)
-     {
-      strcat(end,"\\");
-      strcat(end,sfx);
-      sfx = va_arg(ap,char *);
-     }
-    va_end(ap); 
-    return (w32_perllib_root);
+    char mod_name[MAX_PATH];
+    char *ptr;
+    char *optr;
+    char *strip;
+    int oldsize, newsize;
+
+    va_start(ap, trailing_path);
+    strip = va_arg(ap, char *);
+
+    GetModuleFileName(GetModuleHandle(NULL), mod_name, sizeof(mod_name));
+    ptr = strrchr(mod_name, '\\');
+    while (ptr && strip) {
+        /* look for directories to skip back */
+       optr = ptr;
+       *ptr = '\0';
+       ptr = strrchr(mod_name, '\\');
+       if (!ptr || stricmp(ptr+1, strip) != 0) {
+           *optr = '\\';
+           ptr = optr;
+       }
+       strip = va_arg(ap, char *);
+    }
+    if (!ptr) {
+       ptr = mod_name;
+       *ptr++ = '.';
+       *ptr = '\\';
+    }
+    va_end(ap);
+    strcpy(++ptr, trailing_path);
+
+    newsize = strlen(mod_name) + 1;
+    if (prev_path) {
+       oldsize = strlen(prev_path) + 1;
+       newsize += oldsize;                     /* includes plus 1 for ';' */
+       Renew(prev_path, newsize, char);
+       prev_path[oldsize] = ';';
+       strcpy(&prev_path[oldsize], mod_name);
+    }
+    else {
+       New(1311, prev_path, newsize, char);
+       strcpy(prev_path, mod_name);
+    }
+
+    return prev_path;
+}
+
+char *
+win32_get_privlib(char *pl)
+{
+    char *stdlib = "lib";
+    char buffer[MAX_PATH+1];
+    char *path = Nullch;
+    DWORD datalen;
+
+    /* $stdlib = $HKCU{"lib-$]"} || $HKLM{"lib-$]"} || $HKCU{"lib"} || $HKLM{"lib"} || "";  */
+    sprintf(buffer, "%s-%s", stdlib, pl);
+    path = GetRegStr(buffer, &path, &datalen);
+    if (path == NULL)
+       path = GetRegStr(stdlib, &path, &datalen);
+
+    /* $stdlib .= ";$EMD/../../lib" */
+    return get_emd_part(path, stdlib, ARCHNAME, "bin", Nullch);
+}
+
+char *
+win32_get_sitelib(char *pl)
+{
+    char *sitelib = "sitelib";
+    char regstr[40];
+    char pathstr[MAX_PATH];
+    DWORD datalen;
+    char *path1 = Nullch;
+    char *path2 = Nullch;
+    int len, newsize;
+
+    /* $HKCU{"sitelib-$]"} || $HKLM{"sitelib-$]"} . ---; */
+    sprintf(regstr, "%s-%s", sitelib, pl);
+    path1 = GetRegStr(regstr, &path1, &datalen);
+
+    /* $sitelib .=
+     * ";$EMD/" . ((-d $EMD/../../../$]) ? "../../.." : "../.."). "/site/$]/lib";  */
+    sprintf(pathstr, "site\\%s\\lib", pl);
+    path1 = get_emd_part(path1, pathstr, ARCHNAME, "bin", pl, Nullch);
+
+    /* $HKCU{'sitelib'} || $HKLM{'sitelib'} . ---; */
+    path2 = GetRegStr(sitelib, &path2, &datalen);
+
+    /* $sitelib .=
+     * ";$EMD/" . ((-d $EMD/../../../$]) ? "../../.." : "../.."). "/site/lib";  */
+    path2 = get_emd_part(path2, "site\\lib", ARCHNAME, "bin", pl, Nullch);
+
+    if (!path1)
+       return path2;
+
+    if (!path2)
+       return path1;
+
+    len = strlen(path1);
+    newsize = len + strlen(path2) + 2; /* plus one for ';' */
+
+    Renew(path1, newsize, char);
+    path1[len++] = ';';
+    strcpy(&path1[len], path2);
+
+    Safefree(path2);
+    return path1;
 }
 
 
@@ -138,12 +311,12 @@ has_redirection(char *ptr)
      * Scan string looking for redirection (< or >) or pipe
      * characters (|) that are not in a quoted string
      */
-    while(*ptr) {
+    while (*ptr) {
        switch(*ptr) {
        case '\'':
        case '\"':
-           if(inquote) {
-               if(quote == *ptr) {
+           if (inquote) {
+               if (quote == *ptr) {
                    inquote = 0;
                    quote = '\0';
                }
@@ -156,7 +329,7 @@ has_redirection(char *ptr)
        case '>':
        case '<':
        case '|':
-           if(!inquote)
+           if (!inquote)
                return TRUE;
        default:
            break;
@@ -166,6 +339,7 @@ has_redirection(char *ptr)
     return FALSE;
 }
 
+#if !defined(PERL_OBJECT)
 /* since the current process environment is being updated in util.c
  * the library functions will get the correct environment
  */
@@ -188,10 +362,8 @@ my_popen(char *cmd, char *mode)
 #define fixcmd(x)
 #endif
     fixcmd(cmd);
-#ifdef __BORLANDC__ /* workaround a Borland stdio bug */
     win32_fflush(stdout);
     win32_fflush(stderr);
-#endif
     return win32_popen(cmd, mode);
 }
 
@@ -200,6 +372,7 @@ my_pclose(PerlIO *fp)
 {
     return win32_pclose(fp);
 }
+#endif
 
 static DWORD
 os_id(void)
@@ -309,7 +482,7 @@ do_aspawn(void *vreally, void **vmark, void **vsp)
        flag = SvIVx(*mark);
     }
 
-    while(++mark <= sp) {
+    while (++mark <= sp) {
        if (*mark && (str = SvPV(*mark, na)))
            argv[index++] = str;
        else
@@ -318,7 +491,7 @@ do_aspawn(void *vreally, void **vmark, void **vsp)
     argv[index++] = 0;
    
     status = win32_spawnvp(flag,
-                          (really ? SvPV(really,na) : argv[0]),
+                          (const char*)(really ? SvPV(really,na) : argv[0]),
                           (const char* const*)argv);
 
     if (status < 0 && errno == ENOEXEC) {
@@ -331,22 +504,25 @@ do_aspawn(void *vreally, void **vmark, void **vsp)
            argv[sh_items] = w32_perlshell_vec[sh_items];
    
        status = win32_spawnvp(flag,
-                              (really ? SvPV(really,na) : argv[0]),
+                              (const char*)(really ? SvPV(really,na) : argv[0]),
                               (const char* const*)argv);
     }
 
-    if (status < 0) {
-       if (dowarn)
-           warn("Can't spawn \"%s\": %s", argv[0], strerror(errno));
-       status = 255 * 256;
+    if (flag != P_NOWAIT) {
+       if (status < 0) {
+           if (dowarn)
+               warn("Can't spawn \"%s\": %s", argv[0], strerror(errno));
+           status = 255 * 256;
+       }
+       else
+           status *= 256;
+       statusvalue = status;
     }
-    else if (flag != P_NOWAIT)
-       status *= 256;
     Safefree(argv);
-    return (statusvalue = status);
+    return (status);
 }
 
-static int
+int
 do_spawn2(char *cmd, int exectype)
 {
     char **a;
@@ -358,7 +534,7 @@ do_spawn2(char *cmd, int exectype)
 
     /* Save an extra exec if possible. See if there are shell
      * metacharacters in it */
-    if(!has_redirection(cmd)) {
+    if (!has_redirection(cmd)) {
        New(1301,argv, strlen(cmd) / 2 + 2, char*);
        New(1302,cmd2, strlen(cmd) + 1, char);
        strcpy(cmd2, cmd);
@@ -368,9 +544,9 @@ do_spawn2(char *cmd, int exectype)
                s++;
            if (*s)
                *(a++) = s;
-           while(*s && !isspace(*s))
+           while (*s && !isspace(*s))
                s++;
-           if(*s)
+           if (*s)
                *s++ = '\0';
        }
        *a = Nullch;
@@ -419,16 +595,19 @@ do_spawn2(char *cmd, int exectype)
        cmd = argv[0];
        Safefree(argv);
     }
-    if (status < 0) {
-       if (dowarn)
-           warn("Can't %s \"%s\": %s",
-                (exectype == EXECF_EXEC ? "exec" : "spawn"),
-                cmd, strerror(errno));
-       status = 255 * 256;
+    if (exectype != EXECF_SPAWN_NOWAIT) {
+       if (status < 0) {
+           if (dowarn)
+               warn("Can't %s \"%s\": %s",
+                    (exectype == EXECF_EXEC ? "exec" : "spawn"),
+                    cmd, strerror(errno));
+           status = 255 * 256;
+       }
+       else
+           status *= 256;
+       statusvalue = status;
     }
-    else if (exectype != EXECF_SPAWN_NOWAIT)
-       status *= 256;
-    return (statusvalue = status);
+    return (status);
 }
 
 int
@@ -450,9 +629,6 @@ do_exec(char *cmd)
     return FALSE;
 }
 
-
-#define PATHLEN 1024
-
 /* The idea here is to read all the directory names into a string table
  * (separated by nulls) and when one of the other dir functions is called
  * return the pointer to the current file name.
@@ -460,19 +636,17 @@ do_exec(char *cmd)
 DIR *
 opendir(char *filename)
 {
-    DIR            *p;
-    long            len;
-    long            idx;
-    char            scannamespc[PATHLEN];
-    char       *scanname = scannamespc;
-    struct stat     sbuf;
-    WIN32_FIND_DATA FindData;
-    HANDLE          fh;
-/*  char            root[_MAX_PATH];*/
-/*  char            volname[_MAX_PATH];*/
-/*  DWORD           serial, maxname, flags;*/
-/*  BOOL            downcase;*/
-/*  char           *dummy;*/
+    DIR                        *p;
+    long               len;
+    long               idx;
+    char               scanname[MAX_PATH+3];
+    struct stat                sbuf;
+    WIN32_FIND_DATA    FindData;
+    HANDLE             fh;
+
+    len = strlen(filename);
+    if (len > MAX_PATH)
+       return NULL;
 
     /* check to see if filename is a directory */
     if (win32_stat(filename, &sbuf) < 0 || (sbuf.st_mode & S_IFDIR) == 0) {
@@ -482,35 +656,21 @@ opendir(char *filename)
            return NULL;
     }
 
-    /* get the file system characteristics */
-/*  if(GetFullPathName(filename, MAX_PATH, root, &dummy)) {
- *     if(dummy = strchr(root, '\\'))
- *         *++dummy = '\0';
- *     if(GetVolumeInformation(root, volname, MAX_PATH, &serial,
- *                             &maxname, &flags, 0, 0)) {
- *         downcase = !(flags & FS_CASE_IS_PRESERVED);
- *     }
- *  }
- *  else {
- *     downcase = TRUE;
- *  }
- */
     /* Get us a DIR structure */
     Newz(1303, p, 1, DIR);
-    if(p == NULL)
+    if (p == NULL)
        return NULL;
 
     /* Create the search pattern */
     strcpy(scanname, filename);
-
-    if(index("/\\", *(scanname + strlen(scanname) - 1)) == NULL)
-       strcat(scanname, "/*");
-    else
-       strcat(scanname, "*");
+    if (scanname[len-1] != '/' && scanname[len-1] != '\\')
+       scanname[len++] = '/';
+    scanname[len++] = '*';
+    scanname[len] = '\0';
 
     /* do the FindFirstFile call */
     fh = FindFirstFile(scanname, &FindData);
-    if(fh == INVALID_HANDLE_VALUE) {
+    if (fh == INVALID_HANDLE_VALUE) {
        return NULL;
     }
 
@@ -519,13 +679,9 @@ opendir(char *filename)
      */
     idx = strlen(FindData.cFileName)+1;
     New(1304, p->start, idx, char);
-    if(p->start == NULL) {
+    if (p->start == NULL)
        croak("opendir: malloc failed!\n");
-    }
     strcpy(p->start, FindData.cFileName);
-/*  if(downcase)
- *     strlwr(p->start);
- */
     p->nfiles++;
 
     /* loop finding all the files that match the wildcard
@@ -539,20 +695,16 @@ opendir(char *filename)
         * new name and it's null terminator
         */
        Renew(p->start, idx+len+1, char);
-       if(p->start == NULL) {
+       if (p->start == NULL)
            croak("opendir: malloc failed!\n");
-       }
        strcpy(&p->start[idx], FindData.cFileName);
-/*     if (downcase) 
- *         strlwr(&p->start[idx]);
- */
-               p->nfiles++;
-               idx += len+1;
-       }
-       FindClose(fh);
-       p->size = idx;
-       p->curr = p->start;
-       return p;
+       p->nfiles++;
+       idx += len+1;
+    }
+    FindClose(fh);
+    p->size = idx;
+    p->curr = p->start;
+    return p;
 }
 
 
@@ -681,9 +833,13 @@ getlogin(void)
     return (char*)NULL;
 }
 
-/*
- * pretended kill
- */
+int
+chown(const char *path, uid_t owner, gid_t group)
+{
+    /* XXX noop */
+    return 0;
+}
+
 int
 kill(int pid, int sig)
 {
@@ -699,7 +855,7 @@ kill(int pid, int sig)
     }
     return 0;
 }
-      
+
 /*
  * File system stuff
  */
@@ -764,13 +920,34 @@ win32_getenv(const char *name)
     DWORD needlen;
     if (!curitem)
        New(1305,curitem,curlen,char);
-    if (!(needlen = GetEnvironmentVariable(name,curitem,curlen)))
-       return Nullch;
-    while (needlen > curlen) {
-       Renew(curitem,needlen,char);
-       curlen = needlen;
-       needlen = GetEnvironmentVariable(name,curitem,curlen);
+
+    needlen = GetEnvironmentVariable(name,curitem,curlen);
+    if (needlen != 0) {
+       while (needlen > curlen) {
+           Renew(curitem,needlen,char);
+           curlen = needlen;
+           needlen = GetEnvironmentVariable(name,curitem,curlen);
+       }
+    }
+    else
+    {
+       /* allow any environment variables that begin with 'PERL5'
+          to be stored in the registry
+       */
+       if(curitem != NULL)
+           *curitem = '\0';
+
+       if (strncmp(name, "PERL5", 5) == 0) {
+           if (curitem != NULL) {
+               Safefree(curitem);
+               curitem = NULL;
+           }
+           curitem = GetRegStr(name, &curitem, &curlen);
+       }
     }
+    if(curitem != NULL && *curitem == '\0')
+       return Nullch;
+
     return curitem;
 }
 
@@ -875,7 +1052,7 @@ win32_utime(const char *filename, struct utimbuf *times)
 DllExport int
 win32_wait(int *status)
 {
-#ifdef __BORLANDC__
+#ifdef USE_RTL_WAIT
     return wait(status);
 #else
     /* XXX this wait emulation only knows about processes
@@ -1036,14 +1213,14 @@ my_open_osfhandle(long osfhandle, int flags)
     /* copy relevant flags from second parameter */
     fileflags = FDEV;
 
-    if(flags & O_APPEND)
+    if (flags & O_APPEND)
        fileflags |= FAPPEND;
 
-    if(flags & O_TEXT)
+    if (flags & O_TEXT)
        fileflags |= FTEXT;
 
     /* attempt to allocate a C Runtime file handle */
-    if((fh = _alloc_osfhnd()) == -1) {
+    if ((fh = _alloc_osfhnd()) == -1) {
        errno = EMFILE;         /* too many open files */
        _doserrno = 0L;         /* not an OS error */
        return -1;              /* return error to caller */
@@ -1178,12 +1355,12 @@ win32_strerror(int e)
 #endif
     DWORD source = 0;
 
-    if(e < 0 || e > sys_nerr) {
+    if (e < 0 || e > sys_nerr) {
         dTHR;
-       if(e < 0)
+       if (e < 0)
            e = GetLastError();
 
-       if(FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM, &source, e, 0,
+       if (FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM, &source, e, 0,
                         strerror_buffer, sizeof(strerror_buffer), NULL) == 0) 
            strcpy(strerror_buffer, "Unknown Error");
 
@@ -1209,7 +1386,7 @@ win32_str_os_error(void *sv, DWORD dwErr)
        sMsg[dwLen]= '\0';
     }
     if (0 == dwLen) {
-       sMsg = LocalAlloc(0, 64/**sizeof(TCHAR)*/);
+       sMsg = (char*)LocalAlloc(0, 64/**sizeof(TCHAR)*/);
        dwLen = sprintf(sMsg,
                        "Unknown error #0x%lX (lookup 0x%lX)",
                        dwErr, GetLastError());
@@ -1393,16 +1570,145 @@ win32_pipe(int *pfd, unsigned int size, int mode)
     return _pipe(pfd, size, mode);
 }
 
+/*
+ * a popen() clone that respects PERL5SHELL
+ */
+
 DllExport FILE*
 win32_popen(const char *command, const char *mode)
 {
+#ifdef USE_RTL_POPEN
     return _popen(command, mode);
+#else
+    int p[2];
+    int parent, child;
+    int stdfd, oldfd;
+    int ourmode;
+    int childpid;
+
+    /* establish which ends read and write */
+    if (strchr(mode,'w')) {
+        stdfd = 0;             /* stdin */
+        parent = 1;
+        child = 0;
+    }
+    else if (strchr(mode,'r')) {
+        stdfd = 1;             /* stdout */
+        parent = 0;
+        child = 1;
+    }
+    else
+        return NULL;
+
+    /* set the correct mode */
+    if (strchr(mode,'b'))
+        ourmode = O_BINARY;
+    else if (strchr(mode,'t'))
+        ourmode = O_TEXT;
+    else
+        ourmode = _fmode & (O_TEXT | O_BINARY);
+
+    /* the child doesn't inherit handles */
+    ourmode |= O_NOINHERIT;
+
+    if (win32_pipe( p, 512, ourmode) == -1)
+        return NULL;
+
+    /* save current stdfd */
+    if ((oldfd = win32_dup(stdfd)) == -1)
+        goto cleanup;
+
+    /* make stdfd go to child end of pipe (implicitly closes stdfd) */
+    /* stdfd will be inherited by the child */
+    if (win32_dup2(p[child], stdfd) == -1)
+        goto cleanup;
+
+    /* close the child end in parent */
+    win32_close(p[child]);
+
+    /* start the child */
+    if ((childpid = do_spawn_nowait((char*)command)) == -1)
+        goto cleanup;
+
+    /* revert stdfd to whatever it was before */
+    if (win32_dup2(oldfd, stdfd) == -1)
+        goto cleanup;
+
+    /* close saved handle */
+    win32_close(oldfd);
+
+    sv_setiv(*av_fetch(w32_fdpid, p[parent], TRUE), childpid);
+
+    /* we have an fd, return a file stream */
+    return (win32_fdopen(p[parent], (char *)mode));
+
+cleanup:
+    /* we don't need to check for errors here */
+    win32_close(p[0]);
+    win32_close(p[1]);
+    if (oldfd != -1) {
+        win32_dup2(oldfd, stdfd);
+        win32_close(oldfd);
+    }
+    return (NULL);
+
+#endif /* USE_RTL_POPEN */
 }
 
+/*
+ * pclose() clone
+ */
+
 DllExport int
 win32_pclose(FILE *pf)
 {
+#ifdef USE_RTL_POPEN
     return _pclose(pf);
+#else
+
+#ifndef USE_RTL_WAIT
+    int child;
+#endif
+
+    int childpid, status;
+    SV *sv;
+
+    sv = *av_fetch(w32_fdpid, win32_fileno(pf), TRUE);
+    if (SvIOK(sv))
+       childpid = SvIVX(sv);
+    else
+       childpid = 0;
+
+    if (!childpid) {
+       errno = EBADF;
+        return -1;
+    }
+
+    win32_fclose(pf);
+    SvIVX(sv) = 0;
+
+#ifndef USE_RTL_WAIT
+    for (child = 0 ; child < w32_num_children ; ++child) {
+       if (w32_child_pids[child] == (HANDLE)childpid) {
+           Copy(&w32_child_pids[child+1], &w32_child_pids[child],
+                (w32_num_children-child-1), HANDLE);
+           w32_num_children--;
+           break;
+       }
+    }
+#endif
+
+    /* wait for the child */
+    if (cwait(&status, childpid, WAIT_CHILD) == -1)
+        return (-1);
+    /* cwait() returns differently on Borland */
+#ifdef __BORLANDC__
+    return (((status >> 8) & 0xff) | ((status << 8) & 0xff00));
+#else
+    return (status);
+#endif
+
+#endif /* USE_RTL_POPEN */
 }
 
 DllExport int
@@ -1497,8 +1803,13 @@ win32_spawnvp(int mode, const char *cmdname, const char *const *argv)
 {
     int status;
 
+#ifndef USE_RTL_WAIT
+    if (mode == P_NOWAIT && w32_num_children >= MAXIMUM_WAIT_OBJECTS)
+       return -1;
+#endif
+
     status = spawnvp(mode, cmdname, (char * const *) argv);
-#ifndef __BORLANDC__
+#ifndef USE_RTL_WAIT
     /* XXX For the P_NOWAIT case, Borland RTL returns pinfo.dwProcessId
      * while VC RTL returns pinfo.hProcess. For purposes of the custom
      * implementation of win32_wait(), we assume the latter.
@@ -1724,7 +2035,7 @@ XS(w32_GetCwd)
      */
     if (SvCUR(sv))
        SvPOK_on(sv);
-    EXTEND(sp,1);
+    EXTEND(SP,1);
     ST(0) = sv;
     XSRETURN(1);
 }
@@ -1797,6 +2108,8 @@ static
 XS(w32_DomainName)
 {
     dXSARGS;
+#ifndef HAS_NETWKSTAGETINFO
+    /* mingw32 (and Win95) don't have NetWksta*(), so do it the old way */
     char name[256];
     DWORD size = sizeof(name);
     if (GetUserName(name,&size)) {
@@ -1810,6 +2123,26 @@ XS(w32_DomainName)
            XSRETURN_PV(dname);         /* all that for this */
        }
     }
+#else
+    /* this way is more reliable, in case user has a local account.
+     * XXX need dynamic binding of netapi32.dll symbols or this will fail on
+     * Win95. Probably makes more sense to move it into libwin32. */
+    char dname[256];
+    DWORD dnamelen = sizeof(dname);
+    PWKSTA_INFO_100 pwi;
+    if (NERR_Success == NetWkstaGetInfo(NULL, 100, (LPBYTE*)&pwi)) {
+       if (pwi->wki100_langroup && *(pwi->wki100_langroup)) {
+           WideCharToMultiByte(CP_ACP, NULL, pwi->wki100_langroup,
+                               -1, (LPSTR)dname, dnamelen, NULL, NULL);
+       }
+       else {
+           WideCharToMultiByte(CP_ACP, NULL, pwi->wki100_computername,
+                               -1, (LPSTR)dname, dnamelen, NULL, NULL);
+       }
+       NetApiBufferFree(pwi);
+       XSRETURN_PV(dname);
+    }
+#endif
     XSRETURN_UNDEF;
 }
 
@@ -1893,7 +2226,7 @@ XS(w32_Spawn)
     STARTUPINFO stStartInfo;
     BOOL bSuccess = FALSE;
 
-    if(items != 3)
+    if (items != 3)
        croak("usage: Win32::Spawn($cmdName, $args, $PID)");
 
     cmd = SvPV(ST(0),na);
@@ -1904,7 +2237,7 @@ XS(w32_Spawn)
     stStartInfo.dwFlags = STARTF_USESHOWWINDOW;            /* Enable wShowWindow control */
     stStartInfo.wShowWindow = SW_SHOWMINNOACTIVE;   /* Start min (normal) */
 
-    if(CreateProcess(
+    if (CreateProcess(
                cmd,                    /* Image path */
                args,                   /* Arguments for command line */
                NULL,                   /* Default process security */
@@ -1937,7 +2270,7 @@ XS(w32_GetShortPathName)
     SV *shortpath;
     DWORD len;
 
-    if(items != 1)
+    if (items != 1)
        croak("usage: Win32::GetShortPathName($longPathName)");
 
     shortpath = sv_mortalcopy(ST(0));
@@ -1967,12 +2300,727 @@ XS(w32_Sleep)
     XSRETURN_YES;
 }
 
+#define TMPBUFSZ 1024
+#define MAX_LENGTH 2048
+#define SUCCESSRETURNED(x)     (x == ERROR_SUCCESS)
+#define REGRETURN(x) XSRETURN_IV(SUCCESSRETURNED(x))
+#define SvHKEY(index) (HKEY)((unsigned long)SvIV(index))
+#define SETIV(index,value) sv_setiv(ST(index), value)
+#define SETNV(index,value) sv_setnv(ST(index), value)
+#define SETPV(index,string) sv_setpv(ST(index), string)
+#define SETPVN(index, buffer, length) sv_setpvn(ST(index), (char*)buffer, length)
+#define SETHKEY(index, hkey)   SETIV(index,(long)hkey)
+
+static time_t ft2timet(FILETIME *ft)
+{
+    SYSTEMTIME st;
+    struct tm tm;
+
+    FileTimeToSystemTime(ft, &st);
+    tm.tm_sec = st.wSecond;
+    tm.tm_min = st.wMinute;
+    tm.tm_hour = st.wHour;
+    tm.tm_mday = st.wDay;
+    tm.tm_mon = st.wMonth - 1;
+    tm.tm_year = st.wYear - 1900;
+    tm.tm_wday = st.wDayOfWeek;
+    tm.tm_yday = -1;
+    tm.tm_isdst = -1;
+    return mktime (&tm);
+}
+
+static
+XS(w32_RegCloseKey)
+{
+    dXSARGS;
+
+    if (items != 1) 
+    {
+       croak("usage: Win32::RegCloseKey($hkey);\n");
+    }
+
+    REGRETURN(RegCloseKey(SvHKEY(ST(0))));
+}
+
+static
+XS(w32_RegConnectRegistry)
+{
+    dXSARGS;
+    HKEY handle;
+
+    if (items != 3) 
+    {
+       croak("usage: Win32::RegConnectRegistry($machine, $hkey, $handle);\n");
+    }
+
+    if (SUCCESSRETURNED(RegConnectRegistry((char *)SvPV(ST(0), na), SvHKEY(ST(1)), &handle))) 
+    {
+       SETHKEY(2,handle);
+       XSRETURN_YES;
+    }
+    XSRETURN_NO;
+}
+
+static
+XS(w32_RegCreateKey)
+{
+    dXSARGS;
+    HKEY handle;
+    DWORD disposition;
+    long retval;
+
+    if (items != 3) 
+    {
+       croak("usage: Win32::RegCreateKey($hkey, $subkey, $handle);\n");
+    }
+
+    retval =  RegCreateKeyEx(SvHKEY(ST(0)), (char *)SvPV(ST(1), na), 0, NULL, REG_OPTION_NON_VOLATILE, KEY_ALL_ACCESS,
+                                       NULL, &handle, &disposition);
+
+    if (SUCCESSRETURNED(retval)) 
+    {
+       SETHKEY(2,handle);
+       XSRETURN_YES;
+    }
+    XSRETURN_NO;
+}
+
+static
+XS(w32_RegCreateKeyEx)
+{
+    dXSARGS;
+
+    unsigned int length;
+    long retval;
+    HKEY hkey, handle;
+    char *subkey;
+    char *keyclass;
+    DWORD options, disposition;
+    REGSAM sam;
+    SECURITY_ATTRIBUTES sa, *psa;
+
+    if (items != 9) 
+    {
+       croak("usage: Win32::RegCreateKeyEx($hkey, $subkey, $reserved, $class, $options, $sam, "
+                       "$security, $handle, $disposition);\n");
+    }
+
+    hkey = SvHKEY(ST(0));
+    subkey = (char *)SvPV(ST(1), na);
+    keyclass = (char *)SvPV(ST(3), na);
+    options = (DWORD) ((unsigned long)SvIV(ST(4)));
+    sam = (REGSAM) ((unsigned long)SvIV(ST(5)));
+    psa = (SECURITY_ATTRIBUTES*)SvPV(ST(6), length);
+    if (length != sizeof(SECURITY_ATTRIBUTES))
+    {
+       psa = &sa;
+       memset(&sa, 0, sizeof(SECURITY_ATTRIBUTES));
+       sa.nLength = sizeof(SECURITY_ATTRIBUTES);
+    }
+
+    retval =  RegCreateKeyEx(hkey, subkey, 0, keyclass, options, sam,
+                                       psa, &handle, &disposition);
+
+    if (SUCCESSRETURNED(retval)) 
+    {
+       if (psa == &sa)
+           SETPVN(6, &sa, sizeof(sa));
+
+       SETHKEY(7,handle);
+       SETIV(8,disposition);
+       XSRETURN_YES;
+    }
+    XSRETURN_NO;
+}
+
+static
+XS(w32_RegDeleteKey)
+{
+    dXSARGS;
+
+    if (items != 2) 
+    {
+       croak("usage: Win32::RegDeleteKey($hkey, $subkey);\n");
+    }
+
+    REGRETURN(RegDeleteKey(SvHKEY(ST(0)), (char *)SvPV(ST(1), na)));
+}
+
+static
+XS(w32_RegDeleteValue)
+{
+    dXSARGS;
+
+    if (items != 2) 
+    {
+       croak("usage: Win32::RegDeleteValue($hkey, $valname);\n");
+    }
+
+    REGRETURN(RegDeleteValue(SvHKEY(ST(0)), (char *)SvPV(ST(1), na)));
+}
+
+static
+XS(w32_RegEnumKey)
+{
+    dXSARGS;
+
+    char keybuffer[TMPBUFSZ];
+
+    if (items != 3) 
+    {
+       croak("usage: Win32::RegEnumKey($hkey, $idx, $subkeyname);\n");
+    }
+
+    if (SUCCESSRETURNED(RegEnumKey(SvHKEY(ST(0)), SvIV(ST(1)), keybuffer, sizeof(keybuffer)))) 
+    {
+       SETPV(2, keybuffer);
+       XSRETURN_YES;
+    }
+    XSRETURN_NO;
+}
+
+static
+XS(w32_RegEnumKeyEx)
+{
+    dXSARGS;
+    int length;
+
+    DWORD keysz, classsz;
+    char keybuffer[TMPBUFSZ];
+    char classbuffer[TMPBUFSZ];
+    long retval;
+    FILETIME filetime;
+
+    if (items != 6)                    
+    {
+       croak("usage: Win32::RegEnumKeyEx($hkey, $idx, $subkeyname, $reserved, $class, $time);\n");
+    }
+
+    keysz = sizeof(keybuffer);
+    classsz = sizeof(classbuffer);
+    retval = RegEnumKeyEx(SvHKEY(ST(0)), SvIV(ST(1)), keybuffer, &keysz, 0,
+                                               classbuffer, &classsz, &filetime);
+    if (SUCCESSRETURNED(retval)) 
+    {
+       SETPV(2, keybuffer);
+       SETPV(4, classbuffer);
+       SETIV(5, ft2timet(&filetime));
+       XSRETURN_YES;
+    }
+    XSRETURN_NO;
+}
+
+static
+XS(w32_RegEnumValue)
+{
+    dXSARGS;
+    HKEY hkey;
+    DWORD type, namesz, valsz;
+    long retval;
+    static HKEY last_hkey;
+    char  myvalbuf[MAX_LENGTH];
+    char  mynambuf[MAX_LENGTH];
+
+    if (items != 6) 
+    {
+       croak("usage: Win32::RegEnumValue($hkey, $i, $name, $reserved, $type, $value);\n");
+    }
+
+    hkey = SvHKEY(ST(0));
+
+    // If this is a new key, find out how big the maximum name and value sizes are and
+    // allocate space for them. Free any old storage and set the old key value to the
+    // current key.
+
+    if (hkey != (HKEY)last_hkey) 
+    {
+       char keyclass[TMPBUFSZ];
+       DWORD classsz, subkeys, maxsubkey, maxclass, values, salen, maxnamesz, maxvalsz;
+       FILETIME ft;
+       classsz = sizeof(keyclass);
+       retval = RegQueryInfoKey(hkey, keyclass, &classsz, 0, &subkeys, &maxsubkey, &maxclass,
+                                               &values, &maxnamesz, &maxvalsz, &salen, &ft);
+
+       if (!SUCCESSRETURNED(retval)) 
+       {
+           XSRETURN_NO;
+       }
+       memset(myvalbuf, 0, MAX_LENGTH);
+       memset(mynambuf, 0, MAX_LENGTH);
+       last_hkey = hkey;
+    }
+
+    namesz = MAX_LENGTH;
+    valsz = MAX_LENGTH;
+    retval = RegEnumValue(hkey, SvIV(ST(1)), mynambuf, &namesz, 0, &type, (LPBYTE) myvalbuf, &valsz);
+    if (!SUCCESSRETURNED(retval)) 
+    {
+       XSRETURN_NO;
+    }
+    else 
+    {
+       SETPV(2, mynambuf);
+       SETIV(4, type);
+
+       // return includes the null terminator so delete it if REG_SZ, REG_MULTI_SZ or REG_EXPAND_SZ
+       switch(type)
+       {
+           case REG_SZ:
+           case REG_MULTI_SZ:
+           case REG_EXPAND_SZ:
+               if (valsz)
+                   --valsz;
+           case REG_BINARY:
+               SETPVN(5, myvalbuf, valsz);
+               break;
+
+           case REG_DWORD_BIG_ENDIAN:
+               {
+                   BYTE tmp = myvalbuf[0];
+                   myvalbuf[0] = myvalbuf[3];
+                   myvalbuf[3] = tmp;
+                   tmp = myvalbuf[1];
+                   myvalbuf[1] = myvalbuf[2];
+                   myvalbuf[2] = tmp;
+               }
+           case REG_DWORD_LITTLE_ENDIAN:       // same as REG_DWORD
+               SETNV(5, (double)*((DWORD*)myvalbuf));
+               break;
+
+           default:
+               break;
+       }
+
+       XSRETURN_YES;
+    }
+}
+
+static
+XS(w32_RegFlushKey)
+{
+    dXSARGS;
+
+    if (items != 1) 
+    {
+       croak("usage: Win32::RegFlushKey($hkey);\n");
+    }
+
+    REGRETURN(RegFlushKey(SvHKEY(ST(0))));
+}
+
+static
+XS(w32_RegGetKeySecurity)
+{
+    dXSARGS;
+    SECURITY_DESCRIPTOR sd;
+    DWORD sdsz;
+
+    if (items != 3) 
+    {
+       croak("usage: Win32::RegGetKeySecurity($hkey, $security_info, $security_descriptor);\n");
+    }
+
+    if (SUCCESSRETURNED(RegGetKeySecurity(SvHKEY(ST(0)), SvIV(ST(1)), &sd, &sdsz))) 
+    {
+       SETPVN(2, &sd, sdsz);
+       XSRETURN_YES;
+    }
+    XSRETURN_NO;
+}
+
+static
+XS(w32_RegLoadKey)
+{
+    dXSARGS;
+
+    if (items != 3) 
+    {
+       croak("usage: Win32::RegLoadKey($hkey, $subkey, $filename);\n");
+    }
+
+    REGRETURN(RegLoadKey(SvHKEY(ST(0)), (char *)SvPV(ST(1), na), (char *)SvPV(ST(2), na)));
+}
+
+static
+XS(w32_RegNotifyChangeKeyValue)
+{
+    croak("Win32::RegNotifyChangeKeyValue not yet implemented!\n");
+}
+
+static
+XS(w32_RegOpenKey)
+{
+    dXSARGS;
+    HKEY handle;
+
+    if (items != 3) 
+    {
+       croak("usage: Win32::RegOpenKey($hkey, $subkey, $handle);\n");
+    }
+
+    if (SUCCESSRETURNED(RegOpenKey(SvHKEY(ST(0)), (char *)SvPV(ST(1), na), &handle))) 
+    {
+       SETHKEY(2,handle);
+       XSRETURN_YES;
+    }
+    XSRETURN_NO;
+}
+
+static
+XS(w32_RegOpenKeyEx)
+{
+    dXSARGS;
+    HKEY handle;
+
+    if (items != 5) 
+    {
+       croak("usage: Win32::RegOpenKeyEx($hkey, $subkey, $reserved, $sam, $handle);\n");
+    }
+
+    if (SUCCESSRETURNED(RegOpenKeyEx(SvHKEY(ST(0)), (char *)SvPV(ST(1), na), 
+                               0, (REGSAM) ((unsigned long)SvIV(ST(3))), &handle))) 
+    {
+       SETHKEY(4,handle);
+       XSRETURN_YES;
+    }
+    XSRETURN_NO;
+}
+
+#pragma optimize("", off)
+static
+XS(w32_RegQueryInfoKey)
+{
+    dXSARGS;
+    int length;
+
+    char keyclass[TMPBUFSZ];
+    DWORD subkeys, maxsubkey, maxclass, values, maxvalname, maxvaldata;
+    DWORD seclen, classsz;
+    FILETIME ft;
+    long retval;
+
+    if (items != 10) 
+    {
+       croak("usage: Win32::RegQueryInfoKey($hkey, $class, $numsubkeys, $maxsubkey,"
+               "$maxclass, $values, $maxvalname, $maxvaldata, $secdesclen,"
+                       "$lastwritetime);\n");
+    }
+
+    classsz = sizeof(keyclass);
+    retval = RegQueryInfoKey(SvHKEY(ST(0)), keyclass, &classsz, 0, &subkeys, &maxsubkey,
+                               &maxclass, &values, &maxvalname, &maxvaldata,
+                                       &seclen, &ft);
+    if (SUCCESSRETURNED(retval)) 
+    {
+       SETPV(1, keyclass);
+       SETIV(2, subkeys);
+       SETIV(3, maxsubkey);
+       SETIV(4, maxclass);
+       SETIV(5, values);
+       SETIV(6, maxvalname);
+       SETIV(7, maxvaldata);
+       SETIV(8, seclen);
+       SETIV(9, ft2timet(&ft));
+       XSRETURN_YES;
+    }
+    XSRETURN_NO;
+}
+#pragma optimize("", on)
+
+static
+XS(w32_RegQueryValue)
+{
+    dXSARGS;
+
+    unsigned char databuffer[TMPBUFSZ*2];
+    long datasz = sizeof(databuffer);
+
+    if (items != 3) 
+    {
+       croak("usage: Win32::RegQueryValue($hkey, $valuename, $data);\n");
+    }
+
+    if (SUCCESSRETURNED(RegQueryValue(SvHKEY(ST(0)), SvPV(ST(1), na), (char*)databuffer, &datasz))) 
+    {
+       // return includes the null terminator so delete it
+       SETPVN(2, databuffer, --datasz);
+       XSRETURN_YES;
+    }
+    XSRETURN_NO;
+}
+
+static
+XS(w32_RegQueryValueEx)
+{
+    dXSARGS;
+
+    unsigned char databuffer[TMPBUFSZ*2];
+    DWORD datasz = sizeof(databuffer);
+    DWORD type;
+    LONG result;
+    LPBYTE ptr = databuffer;
+
+    if (items != 5) 
+    {
+       croak("usage: Win32::RegQueryValueEx($hkey, $valuename, $reserved, $type, $data);\n");
+    }
+
+    result = RegQueryValueEx(SvHKEY(ST(0)), SvPV(ST(1), na), 0, &type, ptr, &datasz);
+    if (result == ERROR_MORE_DATA)
+    {
+       New(0, ptr, datasz+1, BYTE);
+       result = RegQueryValueEx(SvHKEY(ST(0)), SvPV(ST(1), na), 0, &type, ptr, &datasz);
+    }
+    if (SUCCESSRETURNED(result)) 
+    {
+       SETIV(3, type);
+
+       // return includes the null terminator so delete it if REG_SZ, REG_MULTI_SZ or REG_EXPAND_SZ
+       switch(type)
+       {
+           case REG_SZ:
+           case REG_MULTI_SZ:
+           case REG_EXPAND_SZ:
+               --datasz;
+           case REG_BINARY:
+               SETPVN(4, ptr, datasz);
+               break;
+
+           case REG_DWORD_BIG_ENDIAN:
+               {
+                   BYTE tmp = ptr[0];
+                   ptr[0] = ptr[3];
+                   ptr[3] = tmp;
+                   tmp = ptr[1];
+                   ptr[1] = ptr[2];
+                   ptr[2] = tmp;
+               }
+           case REG_DWORD_LITTLE_ENDIAN:       // same as REG_DWORD
+               SETNV(4, (double)*((DWORD*)ptr));
+               break;
+
+           default:
+               break;
+       }
+
+       if (ptr != databuffer)
+           safefree(ptr);
+
+       XSRETURN_YES;
+    }
+    if (ptr != databuffer)
+       safefree(ptr);
+
+    XSRETURN_NO;
+}
+
+static
+XS(w32_RegReplaceKey)
+{
+    dXSARGS;
+
+    if (items != 4) 
+    {
+       croak("usage: Win32::RegReplaceKey($hkey, $subkey, $newfile, $oldfile);\n");
+    }
+
+    REGRETURN(RegReplaceKey(SvHKEY(ST(0)), (char *)SvPV(ST(1), na), (char *)SvPV(ST(2), na), (char *)SvPV(ST(3), na)));
+}
+
+static
+XS(w32_RegRestoreKey)
+{
+    dXSARGS;
+
+    if (items < 2 || items > 3) 
+    {
+       croak("usage: Win32::RegRestoreKey($hkey, $filename [, $flags]);\n");
+    }
+
+    REGRETURN(RegRestoreKey(SvHKEY(ST(0)), (char*)SvPV(ST(1), na), (DWORD)((items == 3) ? SvIV(ST(2)) : 0)));
+}
+
+static
+XS(w32_RegSaveKey)
+{
+    dXSARGS;
+
+    if (items != 2) 
+    {
+       croak("usage: Win32::RegSaveKey($hkey, $filename);\n");
+    }
+
+    REGRETURN(RegSaveKey(SvHKEY(ST(0)), (char *)SvPV(ST(1), na), NULL));
+}
+
+static
+XS(w32_RegSetKeySecurity)
+{
+    dXSARGS;
+
+    if (items != 3) 
+    {
+       croak("usage: Win32::RegSetKeySecurity($hkey, $security_info, $security_descriptor);\n");
+    }
+
+    REGRETURN(RegSetKeySecurity(SvHKEY(ST(0)), SvIV(ST(1)), (SECURITY_DESCRIPTOR*)SvPV(ST(2), na)));
+}
+
+static
+XS(w32_RegSetValue)
+{
+    dXSARGS;
+
+    unsigned int size;
+    char *buffer;
+       DWORD type;
+
+    if (items != 4) 
+    {
+       croak("usage: Win32::RegSetValue($hkey, $subKey, $type, $data);\n");
+    }
+
+    type = SvIV(ST(2));
+    if (type != REG_SZ && type != REG_EXPAND_SZ)
+    {
+       croak("Win32::RegSetValue: Type was not REG_SZ or REG_EXPAND_SZ, cannot set %s\n", (char *)SvPV(ST(1), na));
+    }
+
+    buffer = (char *)SvPV(ST(3), size);
+    REGRETURN(RegSetValue(SvHKEY(ST(0)), SvPV(ST(1), na), REG_SZ, buffer, size));
+}
+
+static
+XS(w32_RegSetValueEx)
+{
+    dXSARGS;
+
+    DWORD type;
+    DWORD val;
+    unsigned int size;
+    char *buffer;
+
+    if (items != 5) 
+    {
+       croak("usage: Win32::RegSetValueEx($hkey, $valname, $reserved, $type, $data);\n");
+    }
+
+    type = (DWORD)SvIV(ST(3));
+    switch(type) 
+    {
+       case REG_SZ:
+       case REG_BINARY:
+       case REG_MULTI_SZ:
+       case REG_EXPAND_SZ:
+           buffer = (char *)SvPV(ST(4), size);
+           if (type != REG_BINARY)
+               size++; // include null terminator in size
+
+           REGRETURN(RegSetValueEx(SvHKEY(ST(0)), (char *)SvPV(ST(1), na), 0, type, (PBYTE) buffer, size));
+           break;
+
+       case REG_DWORD_BIG_ENDIAN:
+       case REG_DWORD_LITTLE_ENDIAN: // Same as REG_DWORD
+           val = (DWORD)SvIV(ST(4));
+           REGRETURN(RegSetValueEx(SvHKEY(ST(0)), (char *)SvPV(ST(1), na), 0, type, (PBYTE) &val, sizeof(DWORD)));
+           break;
+
+       default:
+           croak("Win32::RegSetValueEx: Type not specified, cannot set %s\n", (char *)SvPV(ST(1), na));
+    }
+}
+
+static
+XS(w32_RegUnloadKey)
+{
+    dXSARGS;
+
+    if (items != 2) 
+    {
+       croak("usage: Win32::RegUnLoadKey($hkey, $subkey);\n");
+    }
+
+    REGRETURN(RegUnLoadKey(SvHKEY(ST(0)), (char *)SvPV(ST(1), na)));
+}
+
+static
+XS(w32_RegisterServer)
+{
+    dXSARGS;
+    BOOL bSuccess = FALSE;
+    HINSTANCE hInstance;
+    unsigned int length;
+    FARPROC sFunc;
+
+    if (items != 1) 
+    {
+       croak("usage: Win32::RegisterServer($LibraryName)\n");
+    }
+
+    hInstance = LoadLibrary((char *)SvPV(ST(0), length));
+    if (hInstance != NULL)
+    {
+       sFunc = GetProcAddress(hInstance, "DllRegisterServer");
+       if (sFunc != NULL)
+       {
+           bSuccess = (sFunc() == 0);
+       }
+       FreeLibrary(hInstance);
+    }
+
+    if (bSuccess)
+    {
+       XSRETURN_YES;
+    }
+    XSRETURN_NO;
+}
+
+static
+XS(w32_UnregisterServer)
+{
+    dXSARGS;
+    BOOL bSuccess = FALSE;
+    HINSTANCE hInstance;
+    unsigned int length;
+    FARPROC sFunc;
+
+    if (items != 1) 
+    {
+       croak("usage: Win32::UnregisterServer($LibraryName)\n");
+    }
+
+    hInstance = LoadLibrary((char *)SvPV(ST(0), length));
+    if (hInstance != NULL)
+    {
+       sFunc = GetProcAddress(hInstance, "DllUnregisterServer");
+       if (sFunc != NULL)
+       {
+           bSuccess = (sFunc() == 0);
+       }
+       FreeLibrary(hInstance);
+    }
+
+    if (bSuccess)
+    {
+       XSRETURN_YES;
+    }
+    XSRETURN_NO;
+}
+
+
 void
 Perl_init_os_extras()
 {
     char *file = __FILE__;
     dXSUB_SYS;
 
+    w32_perlshell_tokens = Nullch;
+    w32_perlshell_items = -1;
+    w32_fdpid = newAV();               /* XXX needs to be in Perl_win32_init()? */
+#ifndef USE_RTL_WAIT
+    w32_num_children = 0;
+#endif
+
     /* these names are Activeware compatible */
     newXS("Win32::GetCwd", w32_GetCwd, file);
     newXS("Win32::SetCwd", w32_SetCwd, file);
@@ -1991,6 +3039,40 @@ Perl_init_os_extras()
     newXS("Win32::GetShortPathName", w32_GetShortPathName, file);
     newXS("Win32::Sleep", w32_Sleep, file);
 
+    /* the following extensions are used interally and may be changed at any time */
+    /* therefore no documentation is provided */
+    newXS("Win32::RegCloseKey", w32_RegCloseKey, file);
+    newXS("Win32::RegConnectRegistry", w32_RegConnectRegistry, file);
+    newXS("Win32::RegCreateKey", w32_RegCreateKey, file);
+    newXS("Win32::RegCreateKeyEx", w32_RegCreateKeyEx, file);
+    newXS("Win32::RegDeleteKey", w32_RegDeleteKey, file);
+    newXS("Win32::RegDeleteValue", w32_RegDeleteValue, file);
+
+    newXS("Win32::RegEnumKey", w32_RegEnumKey, file);
+    newXS("Win32::RegEnumKeyEx", w32_RegEnumKeyEx, file);
+    newXS("Win32::RegEnumValue", w32_RegEnumValue, file);
+
+    newXS("Win32::RegFlushKey", w32_RegFlushKey, file);
+    newXS("Win32::RegGetKeySecurity", w32_RegGetKeySecurity, file);
+
+    newXS("Win32::RegLoadKey", w32_RegLoadKey, file);
+    newXS("Win32::RegOpenKey", w32_RegOpenKey, file);
+    newXS("Win32::RegOpenKeyEx", w32_RegOpenKeyEx, file);
+    newXS("Win32::RegQueryInfoKey", w32_RegQueryInfoKey, file);
+    newXS("Win32::RegQueryValue", w32_RegQueryValue, file);
+    newXS("Win32::RegQueryValueEx", w32_RegQueryValueEx, file);
+
+    newXS("Win32::RegReplaceKey", w32_RegReplaceKey, file);
+    newXS("Win32::RegRestoreKey", w32_RegRestoreKey, file);
+    newXS("Win32::RegSaveKey", w32_RegSaveKey, file);
+    newXS("Win32::RegSetKeySecurity", w32_RegSetKeySecurity, file);
+    newXS("Win32::RegSetValue", w32_RegSetValue, file);
+    newXS("Win32::RegSetValueEx", w32_RegSetValueEx, file);
+    newXS("Win32::RegUnloadKey", w32_RegUnloadKey, file);
+
+    newXS("Win32::RegisterServer", w32_RegisterServer, file);
+    newXS("Win32::UnregisterServer", w32_UnregisterServer, file);
+
     /* XXX Bloat Alert! The following Activeware preloads really
      * ought to be part of Win32::Sys::*, so they're not included
      * here.
@@ -2015,7 +3097,7 @@ Perl_win32_init(int *argcp, char ***argvp)
 #if !defined(_ALPHA_) && !defined(__GNUC__)
     _control87(MCW_EM, MCW_EM);
 #endif
-    MALLOC_INIT; 
+    MALLOC_INIT;
 }
 
 #ifdef USE_BINMODE_SCRIPTS