[win32] integrate mainline
[p5sagit/p5-mst-13.2.git] / win32 / win32.c
index a73d9e6..9ae2a7d 100644 (file)
@@ -11,6 +11,9 @@
 #define WIN32_LEAN_AND_MEAN
 #define WIN32IO_IS_STDIO
 #include <tchar.h>
+#ifdef __GNUC__
+#define Win32_Winsock
+#endif
 #include <windows.h>
 
 /* #include "config.h" */
 #include "XSUB.h"
 #include <fcntl.h>
 #include <sys/stat.h>
+#ifndef __GNUC__
+/* assert.h conflicts with #define of assert in perl.h */
 #include <assert.h>
+#endif
 #include <string.h>
 #include <stdarg.h>
 #include <float.h>
 
+#ifdef __GNUC__
+/* Mingw32 defaults to globing command line 
+ * So we turn it off like this:
+ */
+int _CRT_glob = 0;
+#endif
+
 #define EXECF_EXEC 1
 #define EXECF_SPAWN 2
 #define EXECF_SPAWN_NOWAIT 3
 
-static DWORD IdOS(void);
-
-BOOL  ProbeEnv = FALSE;
-DWORD Win32System = (DWORD)-1;
-char  szShellPath[MAX_PATH+1];
-char  szPerlLibRoot[MAX_PATH+1];
-HANDLE PerlDllHandle = INVALID_HANDLE_VALUE;
+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);
+static BOOL            has_redirection(char *ptr);
+static long            filetime_to_clock(PFILETIME ft);
+
+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 int do_spawn2(char *cmd, int exectype);
+#ifdef USE_THREADS
+#  ifdef USE_DECLSPEC_THREAD
+__declspec(thread) char        strerror_buffer[512];
+__declspec(thread) char        getlogin_buffer[128];
+#    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 crypt_buffer       (thr->i.Wcrypt_buffer)
+#  endif
+#else
+char   strerror_buffer[512];
+char   getlogin_buffer[128];
+#  ifdef HAVE_DES_FCRYPT
+char   crypt_buffer[30];
+#  endif
+#endif
 
 int 
 IsWin95(void) {
-    return (IdOS() == VER_PLATFORM_WIN32_WINDOWS);
+    return (os_id() == VER_PLATFORM_WIN32_WINDOWS);
 }
 
 int
 IsWinNT(void) {
-    return (IdOS() == VER_PLATFORM_WIN32_NT);
+    return (os_id() == VER_PLATFORM_WIN32_NT);
 }
 
 char *
-win32PerlLibPath(void)
+win32_perllib_path(char *sfx,...)
 {
+    va_list ap;
     char *end;
-    GetModuleFileName((PerlDllHandle == INVALID_HANDLE_VALUE) 
+    va_start(ap,sfx);
+    GetModuleFileName((w32_perldll_handle == INVALID_HANDLE_VALUE) 
                      ? GetModuleHandle(NULL)
-                     : PerlDllHandle,
-                     szPerlLibRoot, 
-                     sizeof(szPerlLibRoot));
-
-    *(end = strrchr(szPerlLibRoot, '\\')) = '\0';
+                     : 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");
-    return (szPerlLibRoot);
+    while (sfx)
+     {
+      strcat(end,"\\");
+      strcat(end,sfx);
+      sfx = va_arg(ap,char *);
+     }
+    va_end(ap); 
+    return (w32_perllib_root);
 }
 
-char *
-win32SiteLibPath(void)
-{
-    static char szPerlSiteLib[MAX_PATH+1];
-    strcpy(szPerlSiteLib, win32PerlLibPath());
-    strcat(szPerlSiteLib, "\\site");
-    return (szPerlSiteLib);
-}
 
-BOOL
-HasRedirection(char *ptr)
+static BOOL
+has_redirection(char *ptr)
 {
     int inquote = 0;
     char quote = '\0';
@@ -154,24 +195,75 @@ my_pclose(PerlIO *fp)
 }
 
 static DWORD
-IdOS(void)
+os_id(void)
 {
     static OSVERSIONINFO osver;
 
-    if (osver.dwPlatformId != Win32System) {
+    if (osver.dwPlatformId != w32_platform) {
        memset(&osver, 0, sizeof(OSVERSIONINFO));
        osver.dwOSVersionInfoSize = sizeof(OSVERSIONINFO);
        GetVersionEx(&osver);
-       Win32System = osver.dwPlatformId;
+       w32_platform = osver.dwPlatformId;
+    }
+    return (w32_platform);
+}
+
+/* Tokenize a string.  Words are null-separated, and the list
+ * ends with a doubled null.  Any character (except null and
+ * including backslash) may be escaped by preceding it with a
+ * backslash (the backslash will be stripped).
+ * Returns number of words in result buffer.
+ */
+static long
+tokenize(char *str, char **dest, char ***destv)
+{
+    char *retstart = Nullch;
+    char **retvstart = 0;
+    int items = -1;
+    if (str) {
+       int slen = strlen(str);
+       register char *ret;
+       register char **retv;
+       New(1307, ret, slen+2, char);
+       New(1308, retv, (slen+3)/2, char*);
+
+       retstart = ret;
+       retvstart = retv;
+       *retv = ret;
+       items = 0;
+       while (*str) {
+           *ret = *str++;
+           if (*ret == '\\' && *str)
+               *ret = *str++;
+           else if (*ret == ' ') {
+               while (*str == ' ')
+                   str++;
+               if (ret == retstart)
+                   ret--;
+               else {
+                   *ret = '\0';
+                   ++items;
+                   if (*str)
+                       *++retv = ret+1;
+               }
+           }
+           else if (!*str)
+               ++items;
+           ret++;
+       }
+       retvstart[items] = Nullch;
+       *ret++ = '\0';
+       *ret = '\0';
     }
-    return (Win32System);
+    *dest = retstart;
+    *destv = retvstart;
+    return items;
 }
 
-static char *
-GetShell(void)
+static void
+get_shell(void)
 {
-    if (!ProbeEnv) {
-       char* defaultshell = (IsWinNT() ? "cmd.exe" : "command.com");
+    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
         *     uncontrolled unportability of the ensuing scripts.
@@ -179,59 +271,75 @@ GetShell(void)
         *     interactive use (which is what most programs look in COMSPEC
         *     for).
         */
-       char *usershell = getenv("PERL5SHELL");  
-
-       ProbeEnv = TRUE;
-       strcpy(szShellPath, usershell ? usershell : defaultshell);
+       char* defaultshell = (IsWinNT() ? "cmd.exe /x/c" : "command.com /c");
+       char *usershell = getenv("PERL5SHELL");
+       w32_perlshell_items = tokenize(usershell ? usershell : defaultshell,
+                                      &w32_perlshell_tokens,
+                                      &w32_perlshell_vec);
     }
-    return szShellPath;
 }
 
 int
-do_aspawn(void* really, void ** mark, void ** arglast)
+do_aspawn(void *vreally, void **vmark, void **vsp)
 {
+    SV *really = (SV*)vreally;
+    SV **mark = (SV**)vmark;
+    SV **sp = (SV**)vsp;
     char **argv;
-    char *strPtr;
-    char *cmd;
+    char *str;
     int status;
-    unsigned int length;
+    int flag = P_WAIT;
     int index = 0;
-    SV *sv = (SV*)really;
-    SV** pSv = (SV**)mark;
 
-    New(1310, argv, (arglast - mark) + 4, char*);
+    if (sp <= mark)
+       return -1;
+
+    get_shell();
+    New(1306, argv, (sp - mark) + w32_perlshell_items + 2, char*);
 
-    if(sv != Nullsv) {
-       cmd = SvPV(sv, length);
-    }
-    else {
-       argv[index++] = cmd = GetShell();
-       if (IsWinNT())
-           argv[index++] = "/x";   /* always enable command extensions */
-       argv[index++] = "/c";
+    if (SvNIOKp(*(mark+1)) && !SvPOKp(*(mark+1))) {
+       ++mark;
+       flag = SvIVx(*mark);
     }
 
-    while(++pSv <= (SV**)arglast) {
-       sv = *pSv;
-       strPtr = SvPV(sv, length);
-       if(strPtr != NULL && *strPtr != '\0')
-           argv[index++] = strPtr;
+    while(++mark <= sp) {
+       if (*mark && (str = SvPV(*mark, na)))
+           argv[index++] = str;
+       else
+           argv[index++] = "";
     }
     argv[index++] = 0;
    
-    status = win32_spawnvp(P_WAIT, cmd, (const char* const*)argv);
-
-    Safefree(argv);
+    status = win32_spawnvp(flag,
+                          (really ? SvPV(really,na) : argv[0]),
+                          (const char* const*)argv);
+
+    if (status < 0 && errno == ENOEXEC) {
+       /* possible shell-builtin, invoke with shell */
+       int sh_items;
+       sh_items = w32_perlshell_items;
+       while (--index >= 0)
+           argv[index+sh_items] = argv[index];
+       while (--sh_items >= 0)
+           argv[sh_items] = w32_perlshell_vec[sh_items];
+   
+       status = win32_spawnvp(flag,
+                              (really ? SvPV(really,na) : argv[0]),
+                              (const char* const*)argv);
+    }
 
     if (status < 0) {
        if (dowarn)
-           warn("Can't spawn \"%s\": %s", cmd, strerror(errno));
-       status = 255 << 8;
+           warn("Can't spawn \"%s\": %s", argv[0], strerror(errno));
+       status = 255 * 256;
     }
-    return (status);
+    else if (flag != P_NOWAIT)
+       status *= 256;
+    Safefree(argv);
+    return (statusvalue = status);
 }
 
-int
+static int
 do_spawn2(char *cmd, int exectype)
 {
     char **a;
@@ -239,13 +347,11 @@ do_spawn2(char *cmd, int exectype)
     char **argv;
     int status = -1;
     BOOL needToTry = TRUE;
-    char *shell, *cmd2;
-
-    /* save an extra exec if possible */
-    shell = GetShell();
+    char *cmd2;
 
-    /* see if there are shell metacharacters in it */
-    if(!HasRedirection(cmd)) {
+    /* Save an extra exec if possible. See if there are shell
+     * metacharacters in it */
+    if(!has_redirection(cmd)) {
        New(1301,argv, strlen(cmd) / 2 + 2, char*);
        New(1302,cmd2, strlen(cmd) + 1, char);
        strcpy(cmd2, cmd);
@@ -261,7 +367,7 @@ do_spawn2(char *cmd, int exectype)
                *s++ = '\0';
        }
        *a = Nullch;
-       if(argv[0]) {
+       if (argv[0]) {
            switch (exectype) {
            case EXECF_SPAWN:
                status = win32_spawnvp(P_WAIT, argv[0],
@@ -275,19 +381,21 @@ do_spawn2(char *cmd, int exectype)
                status = win32_execvp(argv[0], (const char* const*)argv);
                break;
            }
-           if(status != -1 || errno == 0)
+           if (status != -1 || errno == 0)
                needToTry = FALSE;
        }
        Safefree(argv);
        Safefree(cmd2);
     }
-    if(needToTry) {
-       char *argv[5];
-       int i = 0;
-       argv[i++] = shell;
-       if (IsWinNT())
-           argv[i++] = "/x";
-       argv[i++] = "/c"; argv[i++] = cmd; argv[i] = Nullch;
+    if (needToTry) {
+       char **argv;
+       int i = -1;
+       get_shell();
+       New(1306, argv, w32_perlshell_items + 2, char*);
+       while (++i < w32_perlshell_items)
+           argv[i] = w32_perlshell_vec[i];
+       argv[i++] = cmd;
+       argv[i] = Nullch;
        switch (exectype) {
        case EXECF_SPAWN:
            status = win32_spawnvp(P_WAIT, argv[0],
@@ -301,16 +409,19 @@ do_spawn2(char *cmd, int exectype)
            status = win32_execvp(argv[0], (const char* const*)argv);
            break;
        }
+       cmd = argv[0];
+       Safefree(argv);
     }
     if (status < 0) {
        if (dowarn)
            warn("Can't %s \"%s\": %s",
                 (exectype == EXECF_EXEC ? "exec" : "spawn"),
-                needToTry ? shell : argv[0],
-                strerror(errno));
-       status = 255 << 8;
+                cmd, strerror(errno));
+       status = 255 * 256;
     }
-    return (status);
+    else if (exectype != EXECF_SPAWN_NOWAIT)
+       status *= 256;
+    return (statusvalue = status);
 }
 
 int
@@ -319,6 +430,12 @@ do_spawn(char *cmd)
     return do_spawn2(cmd, EXECF_SPAWN);
 }
 
+int
+do_spawn_nowait(char *cmd)
+{
+    return do_spawn2(cmd, EXECF_SPAWN_NOWAIT);
+}
+
 bool
 do_exec(char *cmd)
 {
@@ -532,15 +649,26 @@ getegid(void)
 }
 
 int
-setuid(uid_t uid)
+setuid(uid_t auid)
 { 
-    return (uid == ROOT_UID ? 0 : -1);
+    return (auid == ROOT_UID ? 0 : -1);
 }
 
 int
-setgid(gid_t gid)
+setgid(gid_t agid)
+{
+    return (agid == ROOT_GID ? 0 : -1);
+}
+
+char *
+getlogin(void)
 {
-    return (gid == ROOT_GID ? 0 : -1);
+    dTHR;
+    char *buf = getlogin_buffer;
+    DWORD size = sizeof(getlogin_buffer);
+    if (GetUserName(buf,&size))
+       return buf;
+    return (char*)NULL;
 }
 
 /*
@@ -566,35 +694,13 @@ kill(int pid, int sig)
  * File system stuff
  */
 
-#if 0
-int
-ioctl(int i, unsigned int u, char *data)
-{
-    croak("ioctl not implemented!\n");
-    return -1;
-}
-#endif
-
-unsigned int
-sleep(unsigned int t)
+DllExport unsigned int
+win32_sleep(unsigned int t)
 {
     Sleep(t*1000);
     return 0;
 }
 
-
-#undef rename
-
-int
-myrename(char *OldFileName, char *newname)
-{
-    if(_access(newname, 0) != -1) {    /* file exists */
-       _unlink(newname);
-    }
-    return rename(OldFileName, newname);
-}
-
-
 DllExport int
 win32_stat(const char *path, struct stat *buffer)
 {
@@ -661,7 +767,7 @@ win32_getenv(const char *name)
 #endif
 
 static long
-FileTimeToClock(PFILETIME ft)
+filetime_to_clock(PFILETIME ft)
 {
  __int64 qw = ft->dwHighDateTime;
  qw <<= 32;
@@ -670,17 +776,16 @@ FileTimeToClock(PFILETIME ft)
  return (long) qw;
 }
 
-#undef times
-int
-my_times(struct tms *timebuf)
+DllExport int
+win32_times(struct tms *timebuf)
 {
     FILETIME user;
     FILETIME kernel;
     FILETIME dummy;
     if (GetProcessTimes(GetCurrentProcess(), &dummy, &dummy, 
                         &kernel,&user)) {
-       timebuf->tms_utime = FileTimeToClock(&user);
-       timebuf->tms_stime = FileTimeToClock(&kernel);
+       timebuf->tms_utime = filetime_to_clock(&user);
+       timebuf->tms_stime = filetime_to_clock(&kernel);
        timebuf->tms_cutime = 0;
        timebuf->tms_cstime = 0;
         
@@ -695,8 +800,53 @@ my_times(struct tms *timebuf)
     return 0;
 }
 
-static UINT timerid = 0;
+DllExport int
+win32_wait(int *status)
+{
+#ifdef __BORLANDC__
+    return wait(status);
+#else
+    /* XXX this wait emulation only knows about processes
+     * spawned via win32_spawnvp(P_NOWAIT, ...).
+     */
+    int i, retval;
+    DWORD exitcode, waitcode;
+
+    if (!w32_num_children) {
+       errno = ECHILD;
+       return -1;
+    }
 
+    /* if a child exists, wait for it to die */
+    waitcode = WaitForMultipleObjects(w32_num_children,
+                                     w32_child_pids,
+                                     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_pids[i], &exitcode) ) {
+           CloseHandle(w32_child_pids[i]);
+           *status = (int)((exitcode & 0xff) << 8);
+           retval = (int)w32_child_pids[i];
+           Copy(&w32_child_pids[i+1], &w32_child_pids[i],
+                (w32_num_children-i-1), HANDLE);
+           w32_num_children--;
+           return retval;
+       }
+    }
+
+FAILED:
+    errno = GetLastError();
+    return -1;
+
+#endif
+}
+
+static UINT timerid = 0;
 
 static VOID CALLBACK TimerProc(HWND win, UINT msg, UINT id, DWORD time)
 {
@@ -705,9 +855,8 @@ static VOID CALLBACK TimerProc(HWND win, UINT msg, UINT id, DWORD time)
  sighandler(14);
 }
 
-#undef alarm
-unsigned int
-my_alarm(unsigned int sec)
+DllExport unsigned int
+win32_alarm(unsigned int sec)
 {
     /* 
      * the 'obvious' implentation is SetTimer() with a callback
@@ -735,14 +884,18 @@ my_alarm(unsigned int sec)
     return 0;
 }
 
-#if defined(_DLL) || !defined(_MSC_VER)
-/* It may or may not be fixed (ok on NT), but DLL runtime
-   does not export the functions used in the workround
-*/
-#define WIN95_OSFHANDLE_FIXED
+#ifdef HAVE_DES_FCRYPT
+extern char *  des_fcrypt(char *cbuf, const char *txt, const char *salt);
+
+DllExport char *
+win32_crypt(const char *txt, const char *salt)
+{
+    dTHR;
+    return des_fcrypt(crypt_buffer, txt, salt);
+}
 #endif
 
-#if defined(_WIN32) && !defined(WIN95_OSFHANDLE_FIXED) && defined(_M_IX86)
+#ifdef USE_FIXED_OSFHANDLE
 
 EXTERN_C int __cdecl _alloc_osfhnd(void);
 EXTERN_C int __cdecl _set_osfhnd(int fh, long value);
@@ -841,20 +994,24 @@ my_open_osfhandle(long osfhandle, int flags)
 }
 
 #define _open_osfhandle my_open_osfhandle
-#endif /* _M_IX86 */
+#endif /* USE_FIXED_OSFHANDLE */
 
 /* simulate flock by locking a range on the file */
 
 #define LK_ERR(f,i)    ((f) ? (i = 0) : (errno = GetLastError()))
 #define LK_LEN         0xffff0000
 
-int
-my_flock(int fd, int oper)
+DllExport int
+win32_flock(int fd, int oper)
 {
     OVERLAPPED o;
     int i = -1;
     HANDLE fh;
 
+    if (!IsWinNT()) {
+       croak("flock() unimplemented on this platform");
+       return -1;
+    }
     fh = (HANDLE)_get_osfhandle(fd);
     memset(&o, 0, sizeof(o));
 
@@ -941,8 +1098,6 @@ win32_feof(FILE *fp)
  * we have to roll our own.
  */
 
-__declspec(thread) char        strerror_buffer[512];
-
 DllExport char *
 win32_strerror(int e) 
 {
@@ -952,6 +1107,7 @@ win32_strerror(int e)
     DWORD source = 0;
 
     if(e < 0 || e > sys_nerr) {
+        dTHR;
        if(e < 0)
            e = GetLastError();
 
@@ -964,6 +1120,33 @@ win32_strerror(int e)
     return strerror(e);
 }
 
+DllExport void
+win32_str_os_error(SV *sv, unsigned long dwErr)
+{
+    DWORD dwLen;
+    char *sMsg;
+    dwLen = FormatMessageA(FORMAT_MESSAGE_ALLOCATE_BUFFER
+                         |FORMAT_MESSAGE_IGNORE_INSERTS
+                         |FORMAT_MESSAGE_FROM_SYSTEM, NULL,
+                          dwErr, 0, (char *)&sMsg, 1, NULL);
+    if (0 < dwLen) {
+       while (0 < dwLen  &&  isspace(sMsg[--dwLen]))
+           ;
+       if ('.' != sMsg[dwLen])
+           dwLen++;
+       sMsg[dwLen]= '\0';
+    }
+    if (0 == dwLen) {
+       sMsg = LocalAlloc(0, 64/**sizeof(TCHAR)*/);
+       dwLen = sprintf(sMsg,
+                       "Unknown error #0x%lX (lookup 0x%lX)",
+                       dwErr, GetLastError());
+    }
+    sv_setpvn(sv, sMsg, dwLen);
+    LocalFree(sMsg);
+}
+
+
 DllExport int
 win32_fprintf(FILE *fp, const char *format, ...)
 {
@@ -1014,6 +1197,11 @@ win32_fopen(const char *filename, const char *mode)
     return fopen(filename, mode);
 }
 
+#ifndef USE_SOCKETS_AS_HANDLES
+#undef fdopen
+#define fdopen my_fdopen
+#endif
+
 DllExport FILE *
 win32_fdopen( int handle, const char *mode)
 {
@@ -1031,7 +1219,7 @@ win32_freopen( const char *path, const char *mode, FILE *stream)
 DllExport int
 win32_fclose(FILE *pf)
 {
-    return my_fclose(pf);
+    return my_fclose(pf);      /* defined in win32sck.c */
 }
 
 DllExport int
@@ -1122,9 +1310,9 @@ win32_abort(void)
 }
 
 DllExport int
-win32_fstat(int fd,struct stat *bufptr)
+win32_fstat(int fd,struct stat *sbufptr)
 {
-    return fstat(fd,bufptr);
+    return fstat(fd,sbufptr);
 }
 
 DllExport int
@@ -1235,7 +1423,18 @@ win32_chdir(const char *dir)
 DllExport int
 win32_spawnvp(int mode, const char *cmdname, const char *const *argv)
 {
-    return spawnvp(mode, cmdname, (char * const *) argv);
+    int status;
+
+    status = spawnvp(mode, cmdname, (char * const *) argv);
+#ifndef __BORLANDC__
+    /* 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.
+     */
+    if (mode == P_NOWAIT && status >= 0)
+       w32_child_pids[w32_num_children++] = (HANDLE)status;
+#endif
+    return status;
 }
 
 DllExport int
@@ -1316,6 +1515,85 @@ win32_putchar(int c)
     return putchar(c);
 }
 
+#ifdef MYMALLOC
+
+#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;
+
+void *
+sbrk(int need)
+{
+ void *result;
+ if (!pagesize)
+  {SYSTEM_INFO info;
+   GetSystemInfo(&info);
+   /* Pretend page size is larger so we don't perpetually
+    * call the OS to commit just one page ...
+    */
+   pagesize = info.dwPageSize << 3;
+   allocsize = info.dwAllocationGranularity;
+  }
+ /* This scheme fails eventually if request for contiguous
+  * block is denied so reserve big blocks - this is only 
+  * address space not memory ...
+  */
+ if (brk+need >= reserved)
+  {
+   DWORD size = 64*1024*1024;
+   char *addr;
+   if (committed && reserved && committed < reserved)
+    {
+     /* Commit last of previous chunk cannot span allocations */
+     addr = (char *) VirtualAlloc(committed,reserved-committed,MEM_COMMIT,PAGE_READWRITE);
+     if (addr)
+      committed = reserved;
+    }
+   /* Reserve some (more) space 
+    * Note this is a little sneaky, 1st call passes NULL as reserved
+    * so lets system choose where we start, subsequent calls pass
+    * the old end address so ask for a contiguous block
+    */
+   addr  = (char *) VirtualAlloc(reserved,size,MEM_RESERVE,PAGE_NOACCESS);
+   if (addr)
+    {
+     reserved = addr+size;
+     if (!base)
+      base = addr;
+     if (!committed)
+      committed = base;
+     if (!brk)
+      brk = committed;
+    }
+   else
+    {
+     return (void *) -1;
+    }
+  }
+ result = brk;
+ brk += need;
+ if (brk > committed)
+  {
+   DWORD size = ((brk-committed + pagesize -1)/pagesize) * pagesize;
+   char *addr = (char *) VirtualAlloc(committed,size,MEM_COMMIT,PAGE_READWRITE);
+   if (addr)
+    {
+     committed += size;
+    }
+   else
+    return (void *) -1;
+  }
+ return result;
+}
+
+#endif
+#endif
+
 DllExport void*
 win32_malloc(size_t size)
 {
@@ -1340,6 +1618,7 @@ win32_free(void *block)
     free(block);
 }
 
+
 int
 win32_open_osfhandle(long handle, int flags)
 {
@@ -1356,16 +1635,6 @@ win32_get_osfhandle(int fd)
  * Extras.
  */
 
-DllExport int
-win32_flock(int fd, int oper)
-{
-    if (!IsWinNT()) {
-       croak("flock() unimplemented on this platform");
-       return -1;
-    }
-    return my_flock(fd, oper);
-}
-
 static
 XS(w32_GetCwd)
 {
@@ -1427,8 +1696,8 @@ static
 XS(w32_LoginName)
 {
     dXSARGS;
-    char name[256];
-    DWORD size = sizeof(name);
+    char *name = getlogin_buffer;
+    DWORD size = sizeof(getlogin_buffer);
     if (GetUserName(name,&size)) {
        /* size includes NULL */
        ST(0) = sv_2mortal(newSVpv(name,size-1));
@@ -1617,7 +1886,7 @@ XS(w32_GetShortPathName)
 }
 
 void
-init_os_extras()
+Perl_init_os_extras()
 {
     char *file = __FILE__;
     dXSUB_SYS;
@@ -1663,11 +1932,41 @@ Perl_win32_init(int *argcp, char ***argvp)
      * want to be at the vendor's whim on the default, we set
      * it explicitly here.
      */
-#if !defined(_ALPHA_)
+#if !defined(_ALPHA_) && !defined(__GNUC__)
     _control87(MCW_EM, MCW_EM);
 #endif
+    MALLOC_INIT; 
+}
+
+#ifdef USE_BINMODE_SCRIPTS
+
+void
+win32_strip_return(SV *sv)
+{
+ char *s = SvPVX(sv);
+ char *e = s+SvCUR(sv);
+ char *d = s;
+ while (s < e)
+  {
+   if (*s == '\r' && s[1] == '\n')
+    {
+     *d++ = '\n';
+     s += 2;
+    }
+   else 
+    {
+     *d++ = *s++;
+    }   
+  }
+ SvCUR_set(sv,d-SvPVX(sv)); 
 }
 
+#endif
+
+
+
+
+