Silence STDERR grumblings from Borland's math library.
[p5sagit/p5-mst-13.2.git] / win32 / win32.c
index b36a7b7..21e0424 100644 (file)
@@ -117,6 +117,16 @@ static DWORD       w32_platform = (DWORD)-1;
 
 #define ONE_K_BUFSIZE  1024
 
+#ifdef __BORLANDC__
+/* Silence STDERR grumblings from Borland's math library. */
+DllExport int
+_matherr(struct _exception *a)
+{
+    PERL_UNUSED_VAR(a);
+    return 1;
+}
+#endif
+
 int
 IsWin95(void)
 {
@@ -138,6 +148,10 @@ set_w32_module_name(void)
                                : w32_perldll_handle),
                      w32_module_name, sizeof(w32_module_name));
 
+    /* remove \\?\ prefix */
+    if (memcmp(w32_module_name, "\\\\?\\", 4) == 0)
+        memmove(w32_module_name, w32_module_name+4, strlen(w32_module_name+4)+1);
+
     /* try to get full path to binary (which may be mangled when perl is
      * run from a 16-bit app) */
     /*PerlIO_printf(Perl_debug_log, "Before %s\n", w32_module_name);*/
@@ -253,7 +267,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);
     }
@@ -3601,7 +3616,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, '/');
@@ -3638,7 +3654,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;
     }
@@ -3736,7 +3752,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) {
@@ -3777,17 +3796,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)
@@ -4155,7 +4170,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)
@@ -4168,28 +4182,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)
     {
@@ -4201,6 +4221,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;
@@ -4211,11 +4244,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;
   }
@@ -4807,13 +4841,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;
 
@@ -5092,7 +5128,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++) {
@@ -5146,7 +5181,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);