perl 5.000perl-5.000

[editor's note: this commit combines approximate 4 months of furious
releases of Andy Dougherty and Larry Wall - see pod/perlhist.pod for
details.  Andy notes that;
 
Alas neither my "Irwin AccuTrack" nor my DC 600A quarter-inch cartridge 
backup tapes from that era seem to be readable anymore.  I guess 13 years 
exceeds the shelf life for that backup technology :-(.
]

1 files changed, 94 insertions, 96 deletions

diff --git a/util.c b/util.c
index 1ebb847abe..3d360973a8 100644
--- a/util.c
+++ b/util.c
@@ -1,48 +1,16 @@
-/* $RCSfile: util.c,v $$Revision: 4.1 $$Date: 92/08/07 18:29:00 $
+/*    util.c
  *
- *    Copyright (c) 1991, Larry Wall
+ *    Copyright (c) 1991-1994, 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.
  *
- * $Log:	util.c,v $
- * Revision 4.1  92/08/07  18:29:00  lwall
- * 
- * Revision 4.0.1.6  92/06/11  21:18:47  lwall
- * patch34: boneheaded typo in my_bcopy()
- * 
- * Revision 4.0.1.5  92/06/08  16:08:37  lwall
- * patch20: removed implicit int declarations on functions
- * patch20: Perl now distinguishes overlapped copies from non-overlapped
- * patch20: fixed confusion between a *var's real name and its effective name
- * patch20: bcopy() and memcpy() now tested for overlap safety
- * patch20: added Atari ST portability
- * 
- * Revision 4.0.1.4  91/11/11  16:48:54  lwall
- * patch19: study was busted by 4.018
- * patch19: added little-endian pack/unpack options
- * 
- * Revision 4.0.1.3  91/11/05  19:18:26  lwall
- * patch11: safe malloc code now integrated into Perl's malloc when possible
- * patch11: strchr("little", "longer string") could visit faraway places
- * patch11: warn '-' x 10000 dumped core
- * patch11: forked exec on non-existent program now issues a warning
- * 
- * Revision 4.0.1.2  91/06/07  12:10:42  lwall
- * patch4: new copyright notice
- * patch4: made some allowances for "semi-standard" C
- * patch4: strchr() could blow up searching for null string
- * patch4: taintchecks could improperly modify parent in vfork()
- * patch4: exec would close files even if you cleared close-on-exec flag
- * 
- * Revision 4.0.1.1  91/04/12  09:19:25  lwall
- * patch1: random cleanup in cpp namespace
- * 
- * Revision 4.0  91/03/20  01:56:39  lwall
- * 4.0 baseline.
- * 
  */
-/*SUPPRESS 112*/
+
+/*
+ * "Very useful, no doubt, that was to Saruman; yet it seems that he was
+ * not content."  --Gandalf
+ */
 
 #include "EXTERN.h"
 #include "perl.h"
@@ -68,6 +36,10 @@
 
 #define FLUSH
 
+#ifdef LEAKTEST
+static void xstat _((void));
+#endif
+
 #ifndef safemalloc
 
 /* paranoid version of malloc */
@@ -208,7 +180,8 @@ safexrealloc(where,size)
 char *where;
 MEM_SIZE size;
 {
-    return saferealloc(where - ALIGN, size + ALIGN) + ALIGN;
+    register char *new = saferealloc(where - ALIGN, size + ALIGN);
+    return new + ALIGN;
 }
 
 void
@@ -247,7 +220,7 @@ cpytill(to,from,fromend,delim,retlen)
 register char *to;
 register char *from;
 register char *fromend;
-register I32 delim;
+register int delim;
 I32 *retlen;
 {
     char *origto = to;
@@ -314,7 +287,7 @@ char *lend;
     register I32 first = *little;
     register char *littleend = lend;
 
-    if (!first && little > littleend)
+    if (!first && little >= littleend)
 	return big;
     if (bigend - big < littleend - little)
 	return Nullch;
@@ -348,7 +321,7 @@ char *lend;
     register I32 first = *little;
     register char *littleend = lend;
 
-    if (!first && little > littleend)
+    if (!first && little >= littleend)
 	return bigend;
     bigbeg = big;
     big = bigend - (littleend - little++);
@@ -406,7 +379,7 @@ I32 iflag;
 	s--,i++;
     }
     sv_upgrade(sv, SVt_PVBM);
-    sv_magic(sv, 0, 'B', 0, 0);			/* deep magic */
+    sv_magic(sv, Nullsv, 'B', Nullch, 0);			/* deep magic */
     SvVALID_on(sv);
 
     s = (unsigned char*)(SvPVX(sv));		/* deeper magic */
@@ -451,10 +424,11 @@ SV *littlestr;
     register unsigned char *oldlittle;
 
     if (SvTYPE(littlestr) != SVt_PVBM || !SvVALID(littlestr)) {
-	if (!SvPOK(littlestr) || !SvPVX(littlestr))
+	STRLEN len;
+	char *l = SvPV(littlestr,len);
+	if (!len)
 	    return (char*)big;
-	return ninstr((char*)big,(char*)bigend,
-		SvPVX(littlestr), SvPVX(littlestr) + SvCUR(littlestr));
+	return ninstr((char*)big,(char*)bigend, l, l + len);
     }
 
     littlelen = SvCUR(littlestr);
@@ -657,8 +631,8 @@ SV *littlestr;
 
 I32
 ibcmp(a,b,len)
-register char *a;
-register char *b;
+register U8 *a;
+register U8 *b;
 register I32 len;
 {
     while (len--) {
@@ -676,7 +650,7 @@ register I32 len;
 /* copy a string to a safe spot */
 
 char *
-savestr(sv)
+savepv(sv)
 char *sv;
 {
     register char *newaddr;
@@ -689,7 +663,7 @@ char *sv;
 /* same thing but with a known length */
 
 char *
-nsavestr(sv, len)
+savepvn(sv, len)
 char *sv;
 register I32 len;
 {
@@ -701,7 +675,7 @@ register I32 len;
     return newaddr;
 }
 
-#if !defined(STANDARD_C) && !defined(I_VARARGS)
+#if !defined(I_STDARG) && !defined(I_VARARGS)
 
 /*
  * Fallback on the old hackers way of doing varargs
@@ -737,13 +711,12 @@ long a1, a2, a3, a4;
 		  SvPVX(GvSV(curcop->cop_filegv)), (long)curcop->cop_line);
 		s += strlen(s);
 	    }
-	    if (last_in_gv &&
-		GvIO(last_in_gv) &&
-		IoLINES(GvIO(last_in_gv)) ) {
+	    if (GvIO(last_in_gv) &&
+		IoLINES(GvIOp(last_in_gv)) ) {
 		(void)sprintf(s,", <%s> %s %ld",
 		  last_in_gv == argvgv ? "" : GvENAME(last_in_gv),
 		  strEQ(rs,"\n") ? "line" : "chunk", 
-		  (long)IoLINES(GvIO(last_in_gv)));
+		  (long)IoLINES(GvIOp(last_in_gv)));
 		s += strlen(s);
 	    }
 	    (void)strcpy(s,".\n");
@@ -766,6 +739,10 @@ long a1, a2, a3, a4;
     char *message;
 
     message = mess(pat,a1,a2,a3,a4);
+    if (in_eval) {
+	restartop = die_where(message);
+	longjmp(top_env, 3);
+    }
     fputs(message,stderr);
     (void)fflush(stderr);
     if (e_fp)
@@ -789,9 +766,9 @@ long a1, a2, a3, a4;
     (void)fflush(stderr);
 }
 
-#else /* !defined(STANDARD_C) && !defined(I_VARARGS) */
+#else /* !defined(I_STDARG) && !defined(I_VARARGS) */
 
-#ifdef STANDARD_C
+#ifdef I_STDARG
 char *
 mess(char *pat, va_list *args)
 #else
@@ -835,13 +812,12 @@ mess(pat, args)
 		  SvPVX(GvSV(curcop->cop_filegv)), (long)curcop->cop_line);
 		s += strlen(s);
 	    }
-	    if (last_in_gv &&
-		GvIO(last_in_gv) &&
-		IoLINES(GvIO(last_in_gv)) ) {
+	    if (GvIO(last_in_gv) &&
+		IoLINES(GvIOp(last_in_gv)) ) {
 		(void)sprintf(s,", <%s> %s %ld",
 		  last_in_gv == argvgv ? "" : GvNAME(last_in_gv),
 		  strEQ(rs,"\n") ? "line" : "chunk", 
-		  (long)IoLINES(GvIO(last_in_gv)));
+		  (long)IoLINES(GvIOp(last_in_gv)));
 		s += strlen(s);
 	    }
 	    (void)strcpy(s,".\n");
@@ -868,18 +844,19 @@ croak(pat, va_alist)
 #endif
 {
     va_list args;
-    char *tmps;
     char *message;
 
-#ifdef STANDARD_C
+#ifdef I_STDARG
     va_start(args, pat);
 #else
     va_start(args);
 #endif
     message = mess(pat, &args);
     va_end(args);
-    if (restartop = die_where(message))
+    if (in_eval) {
+	restartop = die_where(message);
 	longjmp(top_env, 3);
+    }
     fputs(message,stderr);
     (void)fflush(stderr);
     if (e_fp)
@@ -901,7 +878,7 @@ warn(pat,va_alist)
     va_list args;
     char *message;
 
-#ifdef STANDARD_C
+#ifdef I_STDARG
     va_start(args, pat);
 #else
     va_start(args);
@@ -915,8 +892,9 @@ warn(pat,va_alist)
 #endif
     (void)fflush(stderr);
 }
-#endif /* !defined(STANDARD_C) && !defined(I_VARARGS) */
+#endif /* !defined(I_STDARG) && !defined(I_VARARGS) */
 
+#ifndef VMS  /* VMS' my_setenv() is in VMS.c */
 void
 my_setenv(nam,val)
 char *nam, *val;
@@ -932,7 +910,7 @@ char *nam, *val;
 	for (max = i; environ[max]; max++) ;
 	New(901,tmpenv, max+2, char*);
 	for (j=0; j<max; j++)		/* copy environment */
-	    tmpenv[j] = savestr(environ[j]);
+	    tmpenv[j] = savepv(environ[j]);
 	tmpenv[max] = Nullch;
 	environ = tmpenv;		/* tell exec where it is now */
     }
@@ -975,6 +953,7 @@ char *nam;
     }					/* potential SEGV's */
     return i;
 }
+#endif /* !VMS */
 
 #ifdef EUNICE
 I32
@@ -1227,7 +1206,7 @@ VTOH(vtohs,short)
 VTOH(vtohl,long)
 #endif
 
-#ifndef DOSISH
+#if  !defined(DOSISH) && !defined(VMS)  /* VMS' my_popen() is in VMS.c */
 FILE *
 my_popen(cmd,mode)
 char	*cmd;
@@ -1269,7 +1248,7 @@ char	*mode;
 	    close(p[THIS]);
 	}
 	if (doexec) {
-#if !defined(HAS_FCNTL) || !defined(FFt_SETFD)
+#if !defined(HAS_FCNTL) || !defined(F_SETFD)
 	    int fd;
 
 #ifndef NOFILE
@@ -1279,7 +1258,6 @@ char	*mode;
 		close(fd);
 #endif
 	    do_exec(cmd);	/* may or may not use the shell */
-	    warn("Can't exec \"%s\": %s", cmd, Strerror(errno));
 	    _exit(1);
 	}
 	/*SUPPRESS 560*/
@@ -1299,7 +1277,7 @@ char	*mode;
 	p[this] = p[that];
     }
     sv = *av_fetch(fdpid,p[this],TRUE);
-    SvUPGRADE(sv,SVt_IV);
+    (void)SvUPGRADE(sv,SVt_IV);
     SvIVX(sv) = pid;
     forkprocess = pid;
     return fdopen(p[this], mode);
@@ -1327,7 +1305,7 @@ char *s;
 
     fprintf(stderr,"%s", s);
     for (fd = 0; fd < 32; fd++) {
-	if (fstat(fd,&tmpstatbuf) >= 0)
+	if (Fstat(fd,&tmpstatbuf) >= 0)
 	    fprintf(stderr," %d",fd);
     }
     fprintf(stderr,"\n");
@@ -1339,9 +1317,9 @@ dup2(oldfd,newfd)
 int oldfd;
 int newfd;
 {
-#if defined(HAS_FCNTL) && defined(FFt_DUPFD)
+#if defined(HAS_FCNTL) && defined(F_DUPFD)
     close(newfd);
-    fcntl(oldfd, FFt_DUPFD, newfd);
+    fcntl(oldfd, F_DUPFD, newfd);
 #else
     int fdtmp[256];
     I32 fdx = 0;
@@ -1359,6 +1337,7 @@ int newfd;
 #endif
 
 #ifndef DOSISH
+#ifndef VMS /* VMS' my_pclose() is in VMS.c */
 I32
 my_pclose(ptr)
 FILE *ptr;
@@ -1369,12 +1348,13 @@ FILE *ptr;
     int (*hstat)(), (*istat)(), (*qstat)();
 #endif
     int status;
-    SV *sv;
+    SV **svp;
     int pid;
 
-    sv = *av_fetch(fdpid,fileno(ptr),TRUE);
-    pid = SvIVX(sv);
-    av_store(fdpid,fileno(ptr),Nullsv);
+    svp = av_fetch(fdpid,fileno(ptr),TRUE);
+    pid = SvIVX(*svp);
+    SvREFCNT_dec(*svp);
+    *svp = &sv_undef;
     fclose(ptr);
 #ifdef UTS
     if(kill(pid, 0) < 0) { return(pid); }   /* HOM 12/23/91 */
@@ -1388,14 +1368,13 @@ FILE *ptr;
     signal(SIGQUIT, qstat);
     return(pid < 0 ? pid : status);
 }
-
+#endif /* !VMS */
 I32
 wait4pid(pid,statusp,flags)
 int pid;
 int *statusp;
 int flags;
 {
-    I32 result;
     SV *sv;
     SV** svp;
     char spid[16];
@@ -1416,7 +1395,7 @@ int flags;
 
 	hv_iterinit(pidstatus);
 	if (entry = hv_iternext(pidstatus)) {
-	    pid = atoi(hv_iterkey(entry,statusp));
+	    pid = atoi(hv_iterkey(entry,(I32*)statusp));
 	    sv = hv_iterval(pidstatus,entry);
 	    *statusp = SvIVX(sv);
 	    sprintf(spid, "%d", pid);
@@ -1424,21 +1403,24 @@ int flags;
 	    return pid;
 	}
     }
-#ifdef HAS_WAIT4
-    return wait4((pid==-1)?0:pid,statusp,flags,Null(struct rusage *));
-#else
 #ifdef HAS_WAITPID
     return waitpid(pid,statusp,flags);
 #else
-    if (flags)
-	croak("Can't do waitpid with flags");
-    else {
-	while ((result = wait(statusp)) != pid && pid > 0 && result >= 0)
-	    pidgone(result,*statusp);
-	if (result < 0)
-	    *statusp = -1;
+#ifdef HAS_WAIT4
+    return wait4((pid==-1)?0:pid,statusp,flags,Null(struct rusage *));
+#else
+    {
+	I32 result;
+	if (flags)
+	    croak("Can't do waitpid with flags");
+	else {
+	    while ((result = wait(statusp)) != pid && pid > 0 && result >= 0)
+		pidgone(result,*statusp);
+	    if (result < 0)
+		*statusp = -1;
+	}
+	return result;
     }
-    return result;
 #endif
 #endif
 }
@@ -1455,7 +1437,7 @@ int status;
 
     sprintf(spid, "%d", pid);
     sv = *hv_fetch(pidstatus,spid,strlen(spid),TRUE);
-    SvUPGRADE(sv,SVt_IV);
+    (void)SvUPGRADE(sv,SVt_IV);
     SvIVX(sv) = status;
     return;
 }
@@ -1529,6 +1511,22 @@ double f;
 }
 # undef BIGDOUBLE
 # undef BIGNEGDOUBLE
+
+IV
+cast_iv(f)
+double f;
+{
+    /* XXX  This should be fixed.  It assumes 32 bit IV's. */
+#   define BIGDOUBLE 2147483648.0        /* Assume 32 bit IV's ! */
+#   define BIGNEGDOUBLE (-2147483648.0)
+    if (f >= BIGDOUBLE)
+	return (IV)fmod(f, BIGDOUBLE);
+    if (f <= BIGNEGDOUBLE)
+	return (IV)fmod(f, BIGNEGDOUBLE);
+    return (IV) f;
+}
+# undef BIGDOUBLE
+# undef BIGNEGDOUBLE
 #endif
 
 #ifndef HAS_RENAME
@@ -1560,13 +1558,13 @@ char *b;
 	strcpy(tmpbuf,".");
     else
 	strncpy(tmpbuf, a, fa - a);
-    if (stat(tmpbuf, &tmpstatbuf1) < 0)
+    if (Stat(tmpbuf, &tmpstatbuf1) < 0)
 	return FALSE;
     if (fb == b)
 	strcpy(tmpbuf,".");
     else
 	strncpy(tmpbuf, b, fb - b);
-    if (stat(tmpbuf, &tmpstatbuf2) < 0)
+    if (Stat(tmpbuf, &tmpstatbuf2) < 0)
 	return FALSE;
     return tmpstatbuf1.st_dev == tmpstatbuf2.st_dev &&
 	   tmpstatbuf1.st_ino == tmpstatbuf2.st_ino;