I'm not convinced that manually creating HVs via sv_upgrade is a great

[perl5.git] / win32 / win32.c

diff --git a/win32/win32.c b/win32/win32.c
index 3883757..40e28f5 100644 (file)
--- a/win32/win32.c
+++ b/win32/win32.c
@@ -253,7 +253,8 @@ get_emd_part(SV **prev_pathp, char *trailing_path, ...)
        dTHX;
        if (!*prev_pathp)
            *prev_pathp = sv_2mortal(newSVpvn("",0));
-       sv_catpvn(*prev_pathp, ";", 1);
+       else if (SvPVX(*prev_pathp))
+           sv_catpvn(*prev_pathp, ";", 1);
        sv_catpv(*prev_pathp, mod_name);
        return SvPVX(*prev_pathp);
     }
@@ -1182,6 +1183,10 @@ win32_stat(const char *path, Stat_t *sbuf)
        /* FindFirstFile() and stat() are buggy with a trailing
         * backslash, so change it to a forward slash :-( */
        case '\\':
+           if (l >= sizeof(buffer)) {
+               errno = ENAMETOOLONG;
+               return -1;
+           }
            strncpy(buffer, path, l-1);
            buffer[l - 1] = '/';
            buffer[l] = '\0';
@@ -3154,7 +3159,7 @@ win32_chsize(int fd, Off_t size)
        do {
            count = extend >= sizeof(b) ? sizeof(b) : (size_t)extend;
            count = win32_write(fd, b, count);
-           if (count < 0) {
+           if ((int)count < 0) {
                retval = -1;
                break;
            }
@@ -3597,7 +3602,8 @@ create_command_line(char *cname, STRLEN clen, const char * const *args)
                || (IsWinNT() && stricmp(&cname[clen-4], ".cmd") == 0)))
        {
            bat_file = TRUE;
-           len += 3;
+           if (!IsWin95())
+               len += 3;
        }
        else {
            char *exe = strrchr(cname, '/');
@@ -3634,7 +3640,7 @@ create_command_line(char *cname, STRLEN clen, const char * const *args)
     New(1310, cmd, len, char);
     ptr = cmd;
 
-    if (bat_file) {
+    if (bat_file && !IsWin95()) {
        *ptr++ = '"';
        extra_quotes = TRUE;
     }
@@ -3732,7 +3738,10 @@ qualified_path(const char *cmd)
 
     /* look in PATH */
     pathstr = PerlEnv_getenv("PATH");
-    New(0, fullcmd, MAX_PATH+1, char);
+
+    /* worst case: PATH is a single directory; we need additional space
+     * to append "/", ".exe" and trailing "\0" */
+    New(0, fullcmd, (pathstr ? strlen(pathstr) : 0) + cmdlen + 6, char);
     curfullcmd = fullcmd;
 
     while (1) {
@@ -3773,17 +3782,13 @@ qualified_path(const char *cmd)
            if (*pathstr == '"') {      /* foo;"baz;etc";bar */
                pathstr++;              /* skip initial '"' */
                while (*pathstr && *pathstr != '"') {
-                   if ((STRLEN)(curfullcmd-fullcmd) < MAX_PATH-cmdlen-5)
-                       *curfullcmd++ = *pathstr;
-                   pathstr++;
+                    *curfullcmd++ = *pathstr++;
                }
                if (*pathstr)
                    pathstr++;          /* skip trailing '"' */
            }
            else {
-               if ((STRLEN)(curfullcmd-fullcmd) < MAX_PATH-cmdlen-5)
-                   *curfullcmd++ = *pathstr;
-               pathstr++;
+                *curfullcmd++ = *pathstr++;
            }
        }
        if (*pathstr)
@@ -4151,7 +4156,6 @@ 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(ptrdiff_t need)
@@ -4164,28 +4168,34 @@ sbrk(ptrdiff_t need)
     * 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;
+   DWORD size = brk+need-reserved;
    char *addr;
+   char *prev_committed = NULL;
    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)
+      {
+      /* Remember where we committed from in case we want to decommit later */
+      prev_committed = committed;
       committed = reserved;
+      }
     }
    /* Reserve some (more) space
+    * Contiguous blocks give us greater efficiency, so reserve big blocks -
+    * this is only address space not memory...
     * 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
     */
+sbrk_reserve:
+   if (size < 64*1024*1024)
+    size = 64*1024*1024;
+   size = ((size + pagesize - 1) / pagesize) * pagesize;
    addr  = (char *) VirtualAlloc(reserved,size,MEM_RESERVE,PAGE_NOACCESS);
    if (addr)
     {
@@ -4197,6 +4207,19 @@ sbrk(ptrdiff_t need)
      if (!brk)
       brk = committed;
     }
+   else if (reserved)
+    {
+      /* The existing block could not be extended far enough, so decommit
+       * anything that was just committed above and start anew */
+      if (prev_committed)
+       {
+       if (!VirtualFree(prev_committed,reserved-prev_committed,MEM_DECOMMIT))
+        return (void *) -1;
+       }
+      reserved = base = committed = brk = NULL;
+      size = need;
+      goto sbrk_reserve;
+    }
    else
     {
      return (void *) -1;
@@ -4207,11 +4230,12 @@ sbrk(ptrdiff_t need)
  if (brk > committed)
   {
    DWORD size = ((brk-committed + pagesize -1)/pagesize) * pagesize;
-   char *addr = (char *) VirtualAlloc(committed,size,MEM_COMMIT,PAGE_READWRITE);
+   char *addr;
+   if (committed+size > reserved)
+    size = reserved-committed;
+   addr = (char *) VirtualAlloc(committed,size,MEM_COMMIT,PAGE_READWRITE);
    if (addr)
-    {
-     committed += size;
-    }
+    committed += size;
    else
     return (void *) -1;
   }
@@ -4618,6 +4642,9 @@ XS(w32_GetOSVersion)
                 XSRETURN_EMPTY;
             }
        }
+       if (GIMME_V == G_SCALAR) {
+           XSRETURN_IV(osverw.dwPlatformId);
+       }
        W2AHELPER(osverw.szCSDVersion, szCSDVersion, sizeof(szCSDVersion));
        XPUSHs(newSVpvn(szCSDVersion, strlen(szCSDVersion)));
         osver.dwMajorVersion    = osverw.dwMajorVersion;
@@ -4638,6 +4665,9 @@ XS(w32_GetOSVersion)
                 XSRETURN_EMPTY;
             }
        }
+       if (GIMME_V == G_SCALAR) {
+           XSRETURN_IV(osver.dwPlatformId);
+       }
        XPUSHs(newSVpvn(osver.szCSDVersion, strlen(osver.szCSDVersion)));
     }
     XPUSHs(newSViv(osver.dwMajorVersion));
@@ -4797,13 +4827,15 @@ XS(w32_GetFullPathName)
     SV *fullpath;
     char *filepart;
     DWORD len;
+    STRLEN filename_len;
+    char *filename_p;
 
     if (items != 1)
        Perl_croak(aTHX_ "usage: Win32::GetFullPathName($filename)");
 
     filename = ST(0);
-    fullpath = sv_mortalcopy(filename);
-    SvUPGRADE(fullpath, SVt_PV);
+    filename_p = SvPV(filename, filename_len);
+    fullpath = sv_2mortal(newSVpvn(filename_p, filename_len));
     if (!SvPVX(fullpath) || !SvLEN(fullpath))
         XSRETURN_UNDEF;
 
@@ -5082,7 +5114,6 @@ Perl_sys_intern_init(pTHX)
     New(1313, w32_pseudo_children, 1, child_tab);
     w32_num_pseudo_children    = 0;
 #  endif
-    w32_init_socktype          = 0;
     w32_timerid                 = 0;
     w32_poll_count              = 0;
     for (i=0; i < SIG_SIZE; i++) {
@@ -5136,7 +5167,6 @@ Perl_sys_intern_dup(pTHX_ struct interp_intern *src, struct interp_intern *dst)
     Newz(1313, dst->children, 1, child_tab);
     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;
     Copy(src->sigtable,dst->sigtable,SIG_SIZE,Sighandler_t);