X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=util.c;h=f61b66d1ae4d950fe27a48ed5ec69664f6de056d;hb=c73bb82c00a639630ef310b1ac1d896f5afcedab;hp=82aeca15d8f983721784d3c17a42b4356e9c422f;hpb=35ff78560a01016ce2a3dffe29f18ce851bc0b90;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/util.c b/util.c
index 82aeca1..f61b66d 100644
--- a/util.c
+++ b/util.c
@@ -14,7 +14,6 @@
 
 #include "EXTERN.h"
 #include "perl.h"
-#include "perlmem.h"
 
 #if !defined(NSIG) || defined(M_UNIX) || defined(M_XENIX)
 #include <signal.h>
@@ -122,13 +121,18 @@ saferealloc(Malloc_t where,MEM_SIZE size)
 	my_exit(1);
     }
 #endif /* HAS_64K_LIMIT */
+    if (!size) {
+	safefree(where);
+	return NULL;
+    }
+
     if (!where)
-	croak("Null realloc");
+	return safemalloc(size);
 #ifdef DEBUGGING
     if ((long)size < 0)
 	croak("panic: realloc");
 #endif
-    ptr = PerlMem_realloc(where,size?size:1);	/* realloc(0) is NASTY on our system */
+    ptr = PerlMem_realloc(where,size);
 
 #if !(defined(I286) || defined(atarist))
     DEBUG_m( {
@@ -1193,23 +1197,11 @@ mess_alloc(void)
     return sv;
 }
 
-#ifdef I_STDARG
 char *
 form(const char* pat, ...)
-#else
-/*VARARGS0*/
-char *
-form(pat, va_alist)
-    const char *pat;
-    va_dcl
-#endif
 {
     va_list args;
-#ifdef I_STDARG
     va_start(args, pat);
-#else
-    va_start(args);
-#endif
     if (!mess_sv)
 	mess_sv = mess_alloc();
     sv_vsetpvfn(mess_sv, pat, strlen(pat), &args, Null(SV**), 0, Null(bool*));
@@ -1249,16 +1241,8 @@ mess(const char *pat, va_list *args)
     return SvPVX(sv);
 }
 
-#ifdef I_STDARG
 OP *
 die(const char* pat, ...)
-#else
-/*VARARGS0*/
-OP *
-die(pat, va_alist)
-    const char *pat;
-    va_dcl
-#endif
 {
     dTHR;
     va_list args;
@@ -1274,11 +1258,7 @@ die(pat, va_alist)
 			  thr, curstack, mainstack));
 #endif /* USE_THREADS */
 
-#ifdef I_STDARG
     va_start(args, pat);
-#else
-    va_start(args);
-#endif
     message = pat ? mess(pat, &args) : Nullch;
     va_end(args);
 
@@ -1309,12 +1289,12 @@ die(pat, va_alist)
 		msg = ERRSV;
 	    }
 
-	    PUSHSTACK(SI_DIEHOOK);
+	    PUSHSTACKi(SI_DIEHOOK);
 	    PUSHMARK(SP);
 	    XPUSHs(msg);
 	    PUTBACK;
 	    perl_call_sv((SV*)cv, G_DISCARD);
-	    POPSTACK();
+	    POPSTACK;
 	    LEAVE;
 	}
     }
@@ -1330,16 +1310,8 @@ die(pat, va_alist)
     return restartop;
 }
 
-#ifdef I_STDARG
 void
 croak(const char* pat, ...)
-#else
-/*VARARGS0*/
-void
-croak(pat, va_alist)
-    char *pat;
-    va_dcl
-#endif
 {
     dTHR;
     va_list args;
@@ -1348,11 +1320,7 @@ croak(pat, va_alist)
     GV *gv;
     CV *cv;
 
-#ifdef I_STDARG
     va_start(args, pat);
-#else
-    va_start(args);
-#endif
     message = mess(pat, &args);
     va_end(args);
 #ifdef USE_THREADS
@@ -1375,12 +1343,12 @@ croak(pat, va_alist)
 	    SvREADONLY_on(msg);
 	    SAVEFREESV(msg);
 
-	    PUSHSTACK(SI_DIEHOOK);
+	    PUSHSTACKi(SI_DIEHOOK);
 	    PUSHMARK(SP);
 	    XPUSHs(msg);
 	    PUTBACK;
 	    perl_call_sv((SV*)cv, G_DISCARD);
-	    POPSTACK();
+	    POPSTACK;
 	    LEAVE;
 	}
     }
@@ -1394,14 +1362,7 @@ croak(pat, va_alist)
 }
 
 void
-#ifdef I_STDARG
 warn(const char* pat,...)
-#else
-/*VARARGS0*/
-warn(pat,va_alist)
-    const char *pat;
-    va_dcl
-#endif
 {
     va_list args;
     char *message;
@@ -1409,11 +1370,7 @@ warn(pat,va_alist)
     GV *gv;
     CV *cv;
 
-#ifdef I_STDARG
     va_start(args, pat);
-#else
-    va_start(args);
-#endif
     message = mess(pat, &args);
     va_end(args);
 
@@ -1435,12 +1392,12 @@ warn(pat,va_alist)
 	    SvREADONLY_on(msg);
 	    SAVEFREESV(msg);
 
-	    PUSHSTACK(SI_WARNHOOK);
+	    PUSHSTACKi(SI_WARNHOOK);
 	    PUSHMARK(SP);
 	    XPUSHs(msg);
 	    PUTBACK;
 	    perl_call_sv((SV*)cv, G_DISCARD);
-	    POPSTACK();
+	    POPSTACK;
 	    LEAVE;
 	    return;
 	}
@@ -1672,7 +1629,6 @@ register I32 len;
 }
 #endif /* !HAS_MEMCMP || !HAS_SANE_MEMCMP */
 
-#if defined(I_STDARG) || defined(I_VARARGS)
 #ifndef HAS_VPRINTF
 
 #ifdef USE_CHAR_VSPRINTF
@@ -1703,7 +1659,6 @@ char *args;
 }
 
 #endif /* HAS_VPRINTF */
-#endif /* I_VARARGS || I_STDARGS */
 
 #ifdef MYSWAP
 #if BYTEORDER != 0x4321
@@ -1876,6 +1831,8 @@ my_popen(char *cmd, char *mode)
     if (pid == 0) {
 	GV* tmpgv;
 
+#undef THIS
+#undef THAT
 #define THIS that
 #define THAT This
 	PerlLIO_close(p[THAT]);
@@ -2176,7 +2133,7 @@ wait4pid(int pid, int *statusp, int flags)
     if (!HAS_WAITPID_RUNTIME)
 	goto hard_way;
 #  endif
-    return waitpid(pid,statusp,flags);
+    return PerlProc_waitpid(pid,statusp,flags);
 #endif
 #if !defined(HAS_WAITPID) && defined(HAS_WAIT4)
     return wait4((pid==-1)?0:pid,statusp,flags,Null(struct rusage *));
@@ -2419,6 +2376,7 @@ find_script(char *scriptname, bool dosearch, char **search_ext, I32 flags)
     dTHR;
     char *xfound = Nullch;
     char *xfailed = Nullch;
+    char tmpbuf[512];
     register char *s;
     I32 len;
     int retval;
@@ -2462,6 +2420,7 @@ find_script(char *scriptname, bool dosearch, char **search_ext, I32 flags)
      *     + look *only* in the PATH for scriptname{,.foo,.bar} (note
      *       this will not look in '.' if it's not in the PATH)
      */
+    tmpbuf[0] = '\0';
 
 #ifdef VMS
 #  ifdef ALWAYS_DEFTYPES
@@ -2481,16 +2440,16 @@ find_script(char *scriptname, bool dosearch, char **search_ext, I32 flags)
 	/* The first time through, just add SEARCH_EXTS to whatever we
 	 * already have, so we can check for default file types. */
 	while (deftypes ||
-	       (!hasdir && my_trnlnm("DCL$PATH",tokenbuf,idx++)) )
+	       (!hasdir && my_trnlnm("DCL$PATH",tmpbuf,idx++)) )
 	{
 	    if (deftypes) {
 		deftypes = 0;
-		*tokenbuf = '\0';
+		*tmpbuf = '\0';
 	    }
-	    if ((strlen(tokenbuf) + strlen(scriptname)
-		 + MAX_EXT_LEN) >= sizeof tokenbuf)
+	    if ((strlen(tmpbuf) + strlen(scriptname)
+		 + MAX_EXT_LEN) >= sizeof tmpbuf)
 		continue;	/* don't search dir with too-long name */
-	    strcat(tokenbuf, scriptname);
+	    strcat(tmpbuf, scriptname);
 #else  /* !VMS */
 
 #ifdef DOSISH
@@ -2519,12 +2478,12 @@ find_script(char *scriptname, bool dosearch, char **search_ext, I32 flags)
 #ifdef SEARCH_EXTS
 	    if (cur == scriptname) {
 		len = strlen(scriptname);
-		if (len+MAX_EXT_LEN+1 >= sizeof(tokenbuf))
+		if (len+MAX_EXT_LEN+1 >= sizeof(tmpbuf))
 		    break;
-		cur = strcpy(tokenbuf, scriptname);
+		cur = strcpy(tmpbuf, scriptname);
 	    }
 	} while (extidx >= 0 && ext[extidx]	/* try an extension? */
-		 && strcpy(tokenbuf+len, ext[extidx++]));
+		 && strcpy(tmpbuf+len, ext[extidx++]));
 #endif
     }
 #endif
@@ -2544,44 +2503,44 @@ find_script(char *scriptname, bool dosearch, char **search_ext, I32 flags)
 		    && *s != ','
 #  endif
 		    && *s != ';'; len++, s++) {
-		if (len < sizeof tokenbuf)
-		    tokenbuf[len] = *s;
+		if (len < sizeof tmpbuf)
+		    tmpbuf[len] = *s;
 	    }
-	    if (len < sizeof tokenbuf)
-		tokenbuf[len] = '\0';
+	    if (len < sizeof tmpbuf)
+		tmpbuf[len] = '\0';
 #else  /* ! (atarist || DOSISH) */
-	    s = delimcpy(tokenbuf, tokenbuf + sizeof tokenbuf, s, bufend,
+	    s = delimcpy(tmpbuf, tmpbuf + sizeof tmpbuf, s, bufend,
 			':',
 			&len);
 #endif /* ! (atarist || DOSISH) */
 	    if (s < bufend)
 		s++;
-	    if (len + 1 + strlen(scriptname) + MAX_EXT_LEN >= sizeof tokenbuf)
+	    if (len + 1 + strlen(scriptname) + MAX_EXT_LEN >= sizeof tmpbuf)
 		continue;	/* don't search dir with too-long name */
 	    if (len
 #if defined(atarist) || defined(DOSISH)
-		&& tokenbuf[len - 1] != '/'
-		&& tokenbuf[len - 1] != '\\'
+		&& tmpbuf[len - 1] != '/'
+		&& tmpbuf[len - 1] != '\\'
 #endif
 	       )
-		tokenbuf[len++] = '/';
-	    if (len == 2 && tokenbuf[0] == '.')
+		tmpbuf[len++] = '/';
+	    if (len == 2 && tmpbuf[0] == '.')
 		seen_dot = 1;
-	    (void)strcpy(tokenbuf + len, scriptname);
+	    (void)strcpy(tmpbuf + len, scriptname);
 #endif  /* !VMS */
 
 #ifdef SEARCH_EXTS
-	    len = strlen(tokenbuf);
+	    len = strlen(tmpbuf);
 	    if (extidx > 0)	/* reset after previous loop */
 		extidx = 0;
 	    do {
 #endif
-	    	DEBUG_p(PerlIO_printf(Perl_debug_log, "Looking for %s\n",tokenbuf));
-		retval = PerlLIO_stat(tokenbuf,&statbuf);
+	    	DEBUG_p(PerlIO_printf(Perl_debug_log, "Looking for %s\n",tmpbuf));
+		retval = PerlLIO_stat(tmpbuf,&statbuf);
 #ifdef SEARCH_EXTS
 	    } while (  retval < 0		/* not there */
 		    && extidx>=0 && ext[extidx]	/* try an extension? */
-		    && strcpy(tokenbuf+len, ext[extidx++])
+		    && strcpy(tmpbuf+len, ext[extidx++])
 		);
 #endif
 	    if (retval < 0)
@@ -2593,28 +2552,31 @@ find_script(char *scriptname, bool dosearch, char **search_ext, I32 flags)
 #endif
 		)
 	    {
-		xfound = tokenbuf;              /* bingo! */
+		xfound = tmpbuf;              /* bingo! */
 		break;
 	    }
 	    if (!xfailed)
-		xfailed = savepv(tokenbuf);
+		xfailed = savepv(tmpbuf);
 	}
 #ifndef DOSISH
 	if (!xfound && !seen_dot && !xfailed && (PerlLIO_stat(scriptname,&statbuf) < 0))
 #endif
 	    seen_dot = 1;			/* Disable message. */
-	if (!xfound) 
-	    scriptname = NULL;
-/*	    croak("Can't %s %s%s%s",
-		  (xfailed ? "execute" : "find"),
-		  (xfailed ? xfailed : scriptname),
-		  (xfailed ? "" : " on PATH"),
-		  (xfailed || seen_dot) ? "" : ", '.' not in PATH"); */
+	if (!xfound) {
+	    if (flags & 1) {			/* do or die? */
+	        croak("Can't %s %s%s%s",
+		      (xfailed ? "execute" : "find"),
+		      (xfailed ? xfailed : scriptname),
+		      (xfailed ? "" : " on PATH"),
+		      (xfailed || seen_dot) ? "" : ", '.' not in PATH");
+	    }
+	    scriptname = Nullch;
+	}
 	if (xfailed)
 	    Safefree(xfailed);
 	scriptname = xfound;
     }
-    return scriptname;
+    return (scriptname ? savepv(scriptname) : Nullch);
 }
 
 
@@ -2895,3 +2857,10 @@ get_opargs(void)
 {
  return opargs;
 }
+
+
+SV **
+get_specialsv_list(void)
+{
+ return specialsv_list;
+}