Two doublewords less

[p5sagit/p5-mst-13.2.git] / util.c

diff --git a/util.c b/util.c
index 95d34e2..fbed244 100644 (file)
--- a/util.c
+++ b/util.c
@@ -1,6 +1,6 @@
 /*    util.c
  *
- *    Copyright (c) 1991-1994, Larry Wall
+ *    Copyright (c) 1991-1997, Larry Wall
  *
  *    You may distribute under the terms of either the GNU General Public
  *    License or the Artistic License, as specified in the README file.
@@ -150,7 +150,7 @@ MEM_SIZE size;
 
 /* safe version of free */
 
-void
+Free_t
 safefree(where)
 Malloc_t where;
 {
@@ -185,13 +185,13 @@ MEM_SIZE size;
     if ((long)size < 0 || (long)count < 0)
        croak("panic: calloc");
 #endif
+    size *= count;
+    ptr = malloc(size?size:1); /* malloc(0) is NASTY on our system */
 #if !(defined(I286) || defined(atarist))
     DEBUG_m(PerlIO_printf(PerlIO_stderr(), "0x%x: (%05d) calloc %ld  x %ld bytes\n",ptr,an++,(long)count,(long)size));
 #else
     DEBUG_m(PerlIO_printf(PerlIO_stderr(), "0x%lx: (%05d) calloc %ld x %ld bytes\n",ptr,an++,(long)count,(long)size));
 #endif
-    size *= count;
-    ptr = malloc(size?size:1); /* malloc(0) is NASTY on our system */
     if (ptr != Nullch) {
        memset((void*)ptr, 0, size);
        return ptr;
@@ -1159,7 +1159,7 @@ die(pat, va_alist)
 {
     va_list args;
     char *message;
-    int oldrunlevel = runlevel;
+    I32 oldrunlevel = runlevel;
     int was_in_eval = in_eval;
     HV *stash;
     GV *gv;
@@ -1191,21 +1191,25 @@ die(pat, va_alist)
        LEAVE;
        if (cv && !CvDEPTH(cv) && (CvROOT(cv) || CvXSUB(cv))) {
            dSP;
-           SV *msg = sv_2mortal(newSVpv(message, 0));
+           SV *msg;
+
+           ENTER;
+           msg = newSVpv(message, 0);
+           SvREADONLY_on(msg);
+           SAVEFREESV(msg);
 
            PUSHMARK(sp);
            XPUSHs(msg);
            PUTBACK;
            perl_call_sv((SV*)cv, G_DISCARD);
 
-           /* It's okay for the __DIE__ hook to modify the message. */
-           message = SvPV(msg, na);
+           LEAVE;
        }
     }
 
     restartop = die_where(message);
     if ((!restartop && was_in_eval) || oldrunlevel > 1)
-       Siglongjmp(top_env, 3);
+       JMPENV_JUMP(3);
     return restartop;
 }
 
@@ -1243,38 +1247,28 @@ croak(pat, va_alist)
        LEAVE;
        if (cv && !CvDEPTH(cv) && (CvROOT(cv) || CvXSUB(cv))) {
            dSP;
-           SV *msg = sv_2mortal(newSVpv(message, 0));
+           SV *msg;
+
+           ENTER;
+           msg = newSVpv(message, 0);
+           SvREADONLY_on(msg);
+           SAVEFREESV(msg);
 
            PUSHMARK(sp);
            XPUSHs(msg);
            PUTBACK;
            perl_call_sv((SV*)cv, G_DISCARD);
 
-           /* It's okay for the __DIE__ hook to modify the message. */
-           message = SvPV(msg, na);
+           LEAVE;
        }
     }
     if (in_eval) {
        restartop = die_where(message);
-       Siglongjmp(top_env, 3);
+       JMPENV_JUMP(3);
     }
     PerlIO_puts(PerlIO_stderr(),message);
     (void)PerlIO_flush(PerlIO_stderr());
-    if (e_tmpname) {
-       if (e_fp) {
-           PerlIO_close(e_fp);
-           e_fp = Nullfp;
-       }
-       (void)UNLINK(e_tmpname);
-       Safefree(e_tmpname);
-       e_tmpname = Nullch;
-    }
-    statusvalue = SHIFTSTATUS(statusvalue);
-#ifdef VMS
-    my_exit((U32)(vaxc$errno?vaxc$errno:(statusvalue?statusvalue:44)));
-#else
-    my_exit((U32)((errno&255)?errno:((statusvalue&255)?statusvalue:255)));
-#endif
+    my_failure_exit();
 }
 
 void
@@ -1311,10 +1305,19 @@ warn(pat,va_alist)
        LEAVE;
        if (cv && !CvDEPTH(cv) && (CvROOT(cv) || CvXSUB(cv))) {
            dSP;
+           SV *msg;
+
+           ENTER;
+           msg = newSVpv(message, 0);
+           SvREADONLY_on(msg);
+           SAVEFREESV(msg);
+
            PUSHMARK(sp);
-           XPUSHs(sv_2mortal(newSVpv(message,0)));
+           XPUSHs(msg);
            PUTBACK;
            perl_call_sv((SV*)cv, G_DISCARD);
+
+           LEAVE;
            return;
        }
     }
@@ -1326,6 +1329,7 @@ warn(pat,va_alist)
 }
 
 #ifndef VMS  /* VMS' my_setenv() is in VMS.c */
+#ifndef _WIN32
 void
 my_setenv(nam,val)
 char *nam, *val;
@@ -1346,6 +1350,7 @@ char *nam, *val;
        environ = tmpenv;               /* tell exec where it is now */
     }
     if (!val) {
+       Safefree(environ[i]);
        while (environ[i]) {
            environ[i] = environ[i+1];
            i++;
@@ -1384,6 +1389,36 @@ char *nam;
     }                                  /* potential SEGV's */
     return i;
 }
+
+#else /* if _WIN32 */
+
+void
+my_setenv(nam,val)
+char *nam, *val;
+{
+    register char *envstr;
+    STRLEN namlen = strlen(nam);
+    STRLEN vallen = strlen(val ? val : "");
+
+    New(9040, envstr, namlen + vallen + 3, char);
+    (void)sprintf(envstr,"%s=%s",nam,val);
+    if (!vallen) {
+        /* An attempt to delete the entry.
+        * We try to fix a Win32 process handling goof: Children
+        * of the current process will end up seeing the
+        * grandparent's entry if the current process has never
+        * modified the entry being deleted. So we call _putenv()
+        * twice: once to pretend to modify the entry, and the
+        * second time to actually delete it. GSAR 97-03-19
+        */
+        envstr[namlen+1] = 'X'; envstr[namlen+2] = '\0';
+       (void)_putenv(envstr);
+       envstr[namlen+1] = '\0';
+    }
+    (void)_putenv(envstr);
+}
+
+#endif /* _WIN32 */
 #endif /* !VMS */
 
 #ifdef UNLINK_ALL_VERSIONS
@@ -1697,7 +1732,7 @@ char      *mode;
        }
        /*SUPPRESS 560*/
        if (tmpgv = gv_fetchpv("$",TRUE, SVt_PV))
-           sv_setiv(GvSV(tmpgv),(I32)getpid());
+           sv_setiv(GvSV(tmpgv), (IV)getpid());
        forkprocess = 0;
        hv_clear(pidstatus);    /* we have no children */
        return Nullfp;