perl 4.0 patch 14: patch #11, continued

See patch #11.

8 files changed, 362 insertions, 93 deletions

diff --git a/doio.c b/doio.c
index 2f1ea17491..0c5a1c946a 100644
--- a/doio.c
+++ b/doio.c
@@ -1,4 +1,4 @@
-/* $RCSfile: doio.c,v $$Revision: 4.0.1.3 $$Date: 91/06/10 01:21:19 $
+/* $RCSfile: doio.c,v $$Revision: 4.0.1.4 $$Date: 91/11/05 16:51:43 $
  *
  *    Copyright (c) 1991, Larry Wall
  *
@@ -6,6 +6,15 @@
  *    License or the Artistic License, as specified in the README file.
  *
  * $Log:	doio.c,v $
+ * Revision 4.0.1.4  91/11/05  16:51:43  lwall
+ * patch11: prepared for ctype implementations that don't define isascii()
+ * patch11: perl mistook some streams for sockets because they return mode 0 too
+ * patch11: reopening STDIN, STDOUT and STDERR failed on some machines
+ * patch11: certain perl errors should set EBADF so that $! looks better
+ * patch11: truncate on a closed filehandle could dump
+ * patch11: stats of _ forgot whether prior stat was actually lstat
+ * patch11: -T returned true on NFS directory
+ * 
  * Revision 4.0.1.3  91/06/10  01:21:19  lwall
  * patch10: read didn't work from character special files open for writing
  * patch10: close-on-exec wrongly set on system file descriptors
@@ -93,7 +102,7 @@ int len;
 
     name = myname;
     forkprocess = 1;		/* assume true if no fork */
-    while (len && isspace(name[len-1]))
+    while (len && isSPACE(name[len-1]))
 	name[--len] = '\0';
     if (!stio)
 	stio = stab_io(stab) = stio_new();
@@ -135,7 +144,8 @@ int len;
     }
     stio->type = *name;
     if (*name == '|') {
-	for (name++; isspace(*name); name++) ;
+	/*SUPPRESS 530*/
+	for (name++; isSPACE(*name); name++) ;
 #ifdef TAINT
 	taintenv();
 	taintproper("Insecure dependency in piped open");
@@ -158,9 +168,9 @@ int len;
 	if (*name == '&') {
 	  duplicity:
 	    name++;
-	    while (isspace(*name))
+	    while (isSPACE(*name))
 		name++;
-	    if (isdigit(*name))
+	    if (isDIGIT(*name))
 		fd = atoi(name);
 	    else {
 		stab = stabent(name,FALSE);
@@ -183,7 +193,7 @@ int len;
 	    }
 	}
 	else {
-	    while (isspace(*name))
+	    while (isSPACE(*name))
 		name++;
 	    if (strEQ(name,"-")) {
 		fp = stdout;
@@ -198,7 +208,7 @@ int len;
 	if (*name == '<') {
 	    mode[0] = 'r';
 	    name++;
-	    while (isspace(*name))
+	    while (isSPACE(*name))
 		name++;
 	    if (*name == '&')
 		goto duplicity;
@@ -215,15 +225,17 @@ int len;
 	    taintproper("Insecure dependency in piped open");
 #endif
 	    name[--len] = '\0';
-	    while (len && isspace(name[len-1]))
+	    while (len && isSPACE(name[len-1]))
 		name[--len] = '\0';
-	    for (; isspace(*name); name++) ;
+	    /*SUPPRESS 530*/
+	    for (; isSPACE(*name); name++) ;
 	    fp = mypopen(name,"r");
 	    stio->type = '|';
 	}
 	else {
 	    stio->type = '<';
-	    for (; isspace(*name); name++) ;
+	    /*SUPPRESS 530*/
+	    for (; isSPACE(*name); name++) ;
 	    if (strEQ(name,"-")) {
 		fp = stdin;
 		stio->type = '-';
@@ -243,9 +255,18 @@ int len;
 	}
 	if (S_ISSOCK(statbuf.st_mode))
 	    stio->type = 's';	/* in case a socket was passed in to us */
+#ifdef HAS_SOCKET
+	else if (
 #ifdef S_IFMT
-	else if (!(statbuf.st_mode & S_IFMT))
-	    stio->type = 's';	/* some OS's return 0 on fstat()ed socket */
+	    !(statbuf.st_mode & S_IFMT)
+#else
+	    !statbuf.st_mode
+#endif
+	) {
+	    if (getsockname(fileno(fp), tokenbuf, 0) >= 0 || errno != ENOTSOCK)
+		stio->type = 's'; /* some OS's return 0 on fstat()ed socket */
+				/* but some return 0 for streams too, sigh */
+	}
 #endif
     }
     if (saveifp) {		/* must use old fp? */
@@ -254,7 +275,8 @@ int len;
 	    fflush(saveofp);		/* emulate fclose() */
 	    if (saveofp != saveifp) {	/* was a socket? */
 		fclose(saveofp);
-		Safefree(saveofp);
+		if (fd > 2)
+		    Safefree(saveofp);
 	    }
 	}
 	if (fd != fileno(fp)) {
@@ -294,8 +316,10 @@ nextargv(stab)
 register STAB *stab;
 {
     register STR *str;
+#ifndef FLEXFILENAMES
     int filedev;
     int fileino;
+#endif
     int fileuid;
     int filegid;
     static int filemode = 0;
@@ -328,8 +352,10 @@ register STAB *stab;
 		    defoutstab = stabent("STDOUT",TRUE);
 		    return stab_io(stab)->ifp;
 		}
+#ifndef FLEXFILENAMES
 		filedev = statbuf.st_dev;
 		fileino = statbuf.st_ino;
+#endif
 		filemode = statbuf.st_mode;
 		fileuid = statbuf.st_uid;
 		filegid = statbuf.st_gid;
@@ -503,8 +529,10 @@ bool explicit;
 
     if (!stab)
 	stab = argvstab;
-    if (!stab)
+    if (!stab) {
+	errno = EBADF;
 	return FALSE;
+    }
     stio = stab_io(stab);
     if (!stio) {		/* never opened */
 	if (dowarn && explicit)
@@ -601,6 +629,7 @@ STAB *stab;
 phooey:
     if (dowarn)
 	warn("tell() on unopened file");
+    errno = EBADF;
     return -1L;
 }
 
@@ -627,6 +656,7 @@ int whence;
 nuts:
     if (dowarn)
 	warn("seek() on unopened file");
+    errno = EBADF;
     return FALSE;
 }
 
@@ -641,11 +671,10 @@ STR *argstr;
     register char *s;
     int retval;
 
-    if (!stab || !argstr)
-	return -1;
-    stio = stab_io(stab);
-    if (!stio)
+    if (!stab || !argstr || !(stio = stab_io(stab)) || !stio->ifp) {
+	errno = EBADF;	/* well, sort of... */
 	return -1;
+    }
 
     if (argstr->str_pok || !argstr->str_nok) {
 	if (!argstr->str_pok)
@@ -847,7 +876,7 @@ off_t length;		/* length to set file to */
 }
 #endif /* F_FREESP */
 
-int
+int					/*SUPPRESS 590*/
 do_truncate(str,arg,gimme,arglast)
 STR *str;
 register ARG *arg;
@@ -864,7 +893,7 @@ int *arglast;
 #ifdef HAS_TRUNCATE
     if ((arg[1].arg_type & A_MASK) == A_WORD) {
 	tmpstab = arg[1].arg_ptr.arg_stab;
-	if (!stab_io(tmpstab) ||
+	if (!stab_io(tmpstab) || !stab_io(tmpstab)->ifp ||
 	  ftruncate(fileno(stab_io(tmpstab)->ifp), len) < 0)
 	    result = 0;
     }
@@ -873,7 +902,7 @@ int *arglast;
 #else
     if ((arg[1].arg_type & A_MASK) == A_WORD) {
 	tmpstab = arg[1].arg_ptr.arg_stab;
-	if (!stab_io(tmpstab) ||
+	if (!stab_io(tmpstab) || !stab_io(tmpstab)->ifp ||
 	  chsize(fileno(stab_io(tmpstab)->ifp), len) < 0)
 	    result = 0;
     }
@@ -913,13 +942,13 @@ STR *str;
 	return TRUE;
     s = str->str_ptr; 
     send = s + str->str_cur;
-    while (isspace(*s))
+    while (isSPACE(*s))
 	s++;
     if (s >= send)
 	return FALSE;
     if (*s == '+' || *s == '-')
 	s++;
-    while (isdigit(*s))
+    while (isDIGIT(*s))
 	s++;
     if (s == send)
 	return TRUE;
@@ -927,7 +956,7 @@ STR *str;
 	s++;
     else if (s == str->str_ptr)
 	return FALSE;
-    while (isdigit(*s))
+    while (isDIGIT(*s))
 	s++;
     if (s == send)
 	return TRUE;
@@ -935,10 +964,10 @@ STR *str;
 	s++;
 	if (*s == '+' || *s == '-')
 	    s++;
-	while (isdigit(*s))
+	while (isDIGIT(*s))
 	    s++;
     }
-    while (isspace(*s))
+    while (isSPACE(*s))
 	s++;
     if (s >= send)
 	return TRUE;
@@ -955,6 +984,7 @@ FILE *fp;
     if (!fp) {
 	if (dowarn)
 	    warn("print to unopened file");
+	errno = EBADF;
 	return FALSE;
     }
     if (!str)
@@ -995,6 +1025,7 @@ int *arglast;
     if (!fp) {
 	if (dowarn)
 	    warn("print to unopened file");
+	errno = EBADF;
 	return FALSE;
     }
     st += ++sp;
@@ -1028,12 +1059,12 @@ STR *str;
 {
     STIO *stio;
 
-    laststype = O_STAT;
     if (arg[1].arg_type & A_DONT) {
 	stio = stab_io(arg[1].arg_ptr.arg_stab);
 	if (stio && stio->ifp) {
 	    statstab = arg[1].arg_ptr.arg_stab;
 	    str_set(statname,"");
+	    laststype = O_STAT;
 	    return (laststatval = fstat(fileno(stio->ifp), &statcache));
 	}
 	else {
@@ -1050,6 +1081,7 @@ STR *str;
     else {
 	statstab = Nullstab;
 	str_set(statname,str_get(str));
+	laststype = O_STAT;
 	return (laststatval = stat(str_get(str),&statcache));
     }
 }
@@ -1107,6 +1139,8 @@ STR *str;
 	if (stio && stio->ifp) {
 #ifdef STDSTDIO
 	    fstat(fileno(stio->ifp),&statcache);
+	    if (S_ISDIR(statcache.st_mode))	/* handle NFS glitch */
+		return arg->arg_type == O_FTTEXT ? &str_no : &str_yes;
 	    if (stio->ifp->_cnt <= 0) {
 		i = getc(stio->ifp);
 		if (i != EOF)
@@ -1117,13 +1151,14 @@ STR *str;
 	    len = stio->ifp->_cnt + (stio->ifp->_ptr - stio->ifp->_base);
 	    s = stio->ifp->_base;
 #else
-	    fatal("-T and -B not implemented on filehandles\n");
+	    fatal("-T and -B not implemented on filehandles");
 #endif
 	}
 	else {
 	    if (dowarn)
 		warn("Test on unopened file <%s>",
 		  stab_name(arg[1].arg_ptr.arg_stab));
+	    errno = EBADF;
 	    return &str_undef;
 	}
     }
@@ -1137,8 +1172,11 @@ STR *str;
 	fstat(i,&statcache);
 	len = read(i,tbuf,512);
 	(void)close(i);
-	if (len <= 0)		/* null file is anything */
-	    return &str_yes;
+	if (len <= 0) {
+	    if (S_ISDIR(statcache.st_mode) && arg->arg_type == O_FTTEXT)
+		return &str_no;		/* special case NFS directories */
+	    return &str_yes;		/* null file is anything */
+	}
 	s = tbuf;
     }
 
@@ -1253,11 +1291,12 @@ char *cmd;
 
     /* see if there are shell metacharacters in it */
 
-    for (s = cmd; *s && isalpha(*s); s++) ;	/* catch VAR=val gizmo */
+    /*SUPPRESS 530*/
+    for (s = cmd; *s && isALPHA(*s); s++) ;	/* catch VAR=val gizmo */
     if (*s == '=')
 	goto doshell;
     for (s = cmd; *s; s++) {
-	if (*s != ' ' && !isalpha(*s) && index("$&*(){}[]'\";\\|?<>~`\n",*s)) {
+	if (*s != ' ' && !isALPHA(*s) && index("$&*(){}[]'\";\\|?<>~`\n",*s)) {
 	    if (*s == '\n' && !s[1]) {
 		*s = '\0';
 		break;
@@ -1271,10 +1310,10 @@ char *cmd;
     Cmd = nsavestr(cmd, s-cmd);
     a = Argv;
     for (s = Cmd; *s;) {
-	while (*s && isspace(*s)) s++;
+	while (*s && isSPACE(*s)) s++;
 	if (*s)
 	    *(a++) = s;
-	while (*s && !isspace(*s)) s++;
+	while (*s && !isSPACE(*s)) s++;
 	if (*s)
 	    *s++ = '\0';
     }
@@ -1301,8 +1340,10 @@ int *arglast;
     register STIO *stio;
     int domain, type, protocol, fd;
 
-    if (!stab)
+    if (!stab) {
+	errno = EBADF;
 	return FALSE;
+    }
 
     stio = stab_io(stab);
     if (!stio)
@@ -1358,6 +1399,7 @@ int *arglast;
 nuts:
     if (dowarn)
 	warn("bind() on closed fd");
+    errno = EBADF;
     return FALSE;
 
 }
@@ -1388,6 +1430,7 @@ int *arglast;
 nuts:
     if (dowarn)
 	warn("connect() on closed fd");
+    errno = EBADF;
     return FALSE;
 
 }
@@ -1415,6 +1458,7 @@ int *arglast;
 nuts:
     if (dowarn)
 	warn("listen() on closed fd");
+    errno = EBADF;
     return FALSE;
 }
 
@@ -1463,6 +1507,7 @@ STAB *gstab;
 nuts:
     if (dowarn)
 	warn("accept() on closed fd");
+    errno = EBADF;
 badexit:
     str_sset(str,&str_undef);
     return;
@@ -1491,6 +1536,7 @@ int *arglast;
 nuts:
     if (dowarn)
 	warn("shutdown() on closed fd");
+    errno = EBADF;
     return FALSE;
 
 }
@@ -1520,7 +1566,7 @@ int *arglast;
     optname = (int)str_gnum(st[sp+2]);
     switch (optype) {
     case O_GSOCKOPT:
-	st[sp] = str_2mortal(str_new(257));
+	st[sp] = str_2mortal(Str_new(22,257));
 	st[sp]->str_cur = 256;
 	st[sp]->str_pok = 1;
 	if (getsockopt(fd, lvl, optname, st[sp]->str_ptr, &st[sp]->str_cur) < 0)
@@ -1540,6 +1586,7 @@ nuts:
     if (dowarn)
 	warn("[gs]etsockopt() on closed fd");
     st[sp] = &str_undef;
+    errno = EBADF;
     return sp;
 
 }
@@ -1562,7 +1609,7 @@ int *arglast;
     if (!stio || !stio->ifp)
 	goto nuts;
 
-    st[sp] = str_2mortal(str_new(257));
+    st[sp] = str_2mortal(Str_new(22,257));
     st[sp]->str_cur = 256;
     st[sp]->str_pok = 1;
     fd = fileno(stio->ifp);
@@ -1582,6 +1629,7 @@ int *arglast;
 nuts:
     if (dowarn)
 	warn("get{sock,peer}name() on closed fd");
+    errno = EBADF;
 nuts2:
     st[sp] = &str_undef;
     return sp;
@@ -2208,6 +2256,7 @@ int *arglast;
     case O_READDIR:
 	if (gimme == G_ARRAY) {
 	    --sp;
+	    /*SUPPRESS 560*/
 	    while (dp = readdir(stio->dirp)) {
 #ifdef DIRNAMLEN
 		(void)astore(ary,++sp,
@@ -2258,6 +2307,8 @@ int *arglast;
 
 nope:
     st[sp] = &str_undef;
+    if (!errno)
+	errno = EBADF;
     return sp;
 
 #else
@@ -2323,7 +2374,7 @@ int *arglast;
 	if (--items > 0) {
 	    tot = items;
 	    s = str_get(st[++sp]);
-	    if (isupper(*s)) {
+	    if (isUPPER(*s)) {
 		if (*s == 'S' && s[1] == 'I' && s[2] == 'G')
 		    s += 3;
 		if (!(val = whichsig(s)))
diff --git a/dolist.c b/dolist.c
index 7527874bf8..345c5acfd3 100644
--- a/dolist.c
+++ b/dolist.c
@@ -1,4 +1,4 @@
-/* $RCSfile: dolist.c,v $$Revision: 4.0.1.2 $$Date: 91/06/10 01:22:15 $
+/* $RCSfile: dolist.c,v $$Revision: 4.0.1.3 $$Date: 91/11/05 17:07:02 $
  *
  *    Copyright (c) 1991, Larry Wall
  *
@@ -6,6 +6,17 @@
  *    License or the Artistic License, as specified in the README file.
  *
  * $Log:	dolist.c,v $
+ * Revision 4.0.1.3  91/11/05  17:07:02  lwall
+ * patch11: prepared for ctype implementations that don't define isascii()
+ * patch11: /$foo/o optimizer could access deallocated data
+ * patch11: certain optimizations of //g in array context returned too many values
+ * patch11: regexp with no parens in array context returned wacky $`, $& and $'
+ * patch11: $' not set right on some //g
+ * patch11: added some support for 64-bit integers
+ * patch11: grep of a split lost its values
+ * patch11: added sort {} LIST
+ * patch11: multiple reallocations now avoided in 1 .. 100000
+ * 
  * Revision 4.0.1.2  91/06/10  01:22:15  lwall
  * patch10: //g only worked first time through
  * 
@@ -94,10 +105,10 @@ int *arglast;
 	if (!spat->spat_regexp->prelen && lastspat)
 	    spat = lastspat;
 	if (spat->spat_flags & SPAT_KEEP) {
+	    scanconst(spat,spat->spat_regexp->precomp, spat->spat_regexp->prelen);
 	    if (spat->spat_runtime)
 		arg_free(spat->spat_runtime);	/* it won't change, so */
 	    spat->spat_runtime = Nullarg;	/* no point compiling again */
-	    scanconst(spat, t, tmpstr->str_cur);
 	    hoistmust(spat);
 	    if (curcmd->c_expr && (curcmd->c_flags & CF_OPTIMIZE) == CFT_EVAL) {
 		curcmd->c_flags &= ~CF_OPTIMIZE;
@@ -145,7 +156,7 @@ int *arglast;
 	t = s;
     play_it_again:
 	if (global && spat->spat_regexp->startp[0])
-	    s = spat->spat_regexp->endp[0];
+	    t = s = spat->spat_regexp->endp[0];
 	if (myhint) {
 	    if (myhint < s || myhint > strend)
 		fatal("panic: hint in do_match");
@@ -192,8 +203,10 @@ int *arglast;
 		spat->spat_short = Nullstr;	/* opt is being useless */
 	    }
 	}
-	if (!spat->spat_regexp->nparens && !global)
+	if (!spat->spat_regexp->nparens && !global) {
 	    gimme = G_SCALAR;			/* accidental array context? */
+	    safebase = FALSE;
+	}
 	if (regexec(spat->spat_regexp, s, strend, t, 0,
 	  srchstr->str_pok & SP_STUDIED ? srchstr : Nullstr,
 	  safebase)) {
@@ -233,6 +246,7 @@ int *arglast;
 
 	for (i = !i; i <= iters; i++) {
 	    st[++sp] = str_mortal(&str_no);
+	    /*SUPPRESS 560*/
 	    if (s = spat->spat_regexp->startp[i]) {
 		len = spat->spat_regexp->endp[i] - s;
 		if (len > 0)
@@ -256,6 +270,8 @@ yup:
     if (spat->spat_flags & SPAT_ONCE)
 	spat->spat_flags |= SPAT_USED;
     if (global) {
+	spat->spat_regexp->subbeg = t;
+	spat->spat_regexp->subend = strend;
 	spat->spat_regexp->startp[0] = s;
 	spat->spat_regexp->endp[0] = s + spat->spat_short->str_cur;
 	curspat = spat;
@@ -363,14 +379,15 @@ int *arglast;
 	ary = stack;
     orig = s;
     if (spat->spat_flags & SPAT_SKIPWHITE) {
-	while (isascii(*s) && isspace(*s))
+	while (isSPACE(*s))
 	    s++;
     }
     if (!limit)
 	limit = maxiters + 2;
     if (strEQ("\\s+",spat->spat_regexp->precomp)) {
 	while (--limit) {
-	    for (m = s; m < strend && !(isascii(*m)&&isspace(*m)); m++) ;
+	    /*SUPPRESS 530*/
+	    for (m = s; m < strend && !isSPACE(*m); m++) ;
 	    if (m >= strend)
 		break;
 	    dstr = Str_new(30,m-s);
@@ -378,11 +395,13 @@ int *arglast;
 	    if (!realarray)
 		str_2mortal(dstr);
 	    (void)astore(ary, ++sp, dstr);
-	    for (s = m + 1; s < strend && isascii(*s) && isspace(*s); s++) ;
+	    /*SUPPRESS 530*/
+	    for (s = m + 1; s < strend && isSPACE(*s); s++) ;
 	}
     }
     else if (strEQ("^",spat->spat_regexp->precomp)) {
 	while (--limit) {
+	    /*SUPPRESS 530*/
 	    for (m = s; m < strend && *m != '\n'; m++) ;
 	    m++;
 	    if (m >= strend)
@@ -401,17 +420,17 @@ int *arglast;
 	    int fold = (spat->spat_flags & SPAT_FOLD);
 
 	    i = *spat->spat_short->str_ptr;
-	    if (fold && isupper(i))
+	    if (fold && isUPPER(i))
 		i = tolower(i);
 	    while (--limit) {
 		if (fold) {
 		    for ( m = s;
 			  m < strend && *m != i &&
-			    (!isupper(*m) || tolower(*m) != i);
-			  m++)
+			    (!isUPPER(*m) || tolower(*m) != i);
+			  m++)			/*SUPPRESS 530*/
 			;
 		}
-		else
+		else				/*SUPPRESS 530*/
 		    for (m = s; m < strend && *m != i; m++) ;
 		if (m >= strend)
 		    break;
@@ -548,9 +567,15 @@ int *arglast;
     short ashort;
     int aint;
     long along;
+#ifdef QUAD
+    quad aquad;
+#endif
     unsigned short aushort;
     unsigned int auint;
     unsigned long aulong;
+#ifdef QUAD
+    unsigned quad auquad;
+#endif
     char *aptr;
     float afloat;
     double adouble;
@@ -559,10 +584,11 @@ int *arglast;
     double cdouble;
 
     if (gimme != G_ARRAY) {		/* arrange to do first one only */
-	for (patend = pat; !isalpha(*patend); patend++);
+	/*SUPPRESS 530*/
+	for (patend = pat; !isALPHA(*patend) || *patend == 'x'; patend++) ;
 	if (index("aAbBhH", *patend) || *pat == '%') {
 	    patend++;
-	    while (isdigit(*patend) || *patend == '*')
+	    while (isDIGIT(*patend) || *patend == '*')
 		patend++;
 	}
 	else
@@ -578,9 +604,9 @@ int *arglast;
 	    len = strend - strbeg;	/* long enough */
 	    pat++;
 	}
-	else if (isdigit(*pat)) {
+	else if (isDIGIT(*pat)) {
 	    len = *pat++ - '0';
-	    while (isdigit(*pat))
+	    while (isDIGIT(*pat))
 		len = (len * 10) + (*pat++ - '0');
 	}
 	else
@@ -624,7 +650,7 @@ int *arglast;
 	    if (datumtype == 'A') {
 		aptr = s;	/* borrow register */
 		s = str->str_ptr + len - 1;
-		while (s >= str->str_ptr && (!*s || (isascii(*s)&&isspace(*s))))
+		while (s >= str->str_ptr && (!*s || isSPACE(*s)))
 		    s--;
 		*++s = '\0';
 		str->str_cur = s - str->str_ptr;
@@ -644,7 +670,7 @@ int *arglast;
 	    if (datumtype == 'b') {
 		aint = len;
 		for (len = 0; len < aint; len++) {
-		    if (len & 7)
+		    if (len & 7)		/*SUPPRESS 595*/
 			bits >>= 1;
 		    else
 			bits = *s++;
@@ -912,6 +938,34 @@ int *arglast;
 		(void)astore(stack, ++sp, str_2mortal(str));
 	    }
 	    break;
+#ifdef QUAD
+	case 'q':
+	    while (len-- > 0) {
+		if (s + sizeof(quad) > strend)
+		    aquad = 0;
+		else {
+		    bcopy(s,(char*)&aquad,sizeof(quad));
+		    s += sizeof(quad);
+		}
+		str = Str_new(42,0);
+		str_numset(str,(double)aquad);
+		(void)astore(stack, ++sp, str_2mortal(str));
+	    }
+	    break;
+	case 'Q':
+	    while (len-- > 0) {
+		if (s + sizeof(unsigned quad) > strend)
+		    auquad = 0;
+		else {
+		    bcopy(s,(char*)&auquad,sizeof(unsigned quad));
+		    s += sizeof(unsigned quad);
+		}
+		str = Str_new(43,0);
+		str_numset(str,(double)auquad);
+		(void)astore(stack, ++sp, str_2mortal(str));
+	    }
+	    break;
+#endif
 	/* float and double added gnb@melba.bby.oz.au 22/11/89 */
 	case 'f':
 	case 'F':
@@ -1158,11 +1212,11 @@ int *arglast;
 		length = 0;
 	}
 	else
-	    length = ary->ary_max;		/* close enough to infinity */
+	    length = ary->ary_max + 1;		/* close enough to infinity */
     }
     else {
 	offset = 0;
-	length = ary->ary_max;
+	length = ary->ary_max + 1;
     }
     if (offset < 0) {
 	length += offset;
@@ -1335,8 +1389,10 @@ int *arglast;
     }
     arg = arg[1].arg_ptr.arg_arg;
     while (i-- > 0) {
-	if (st[src])
+	if (st[src]) {
+	    st[src]->str_pok &= ~SP_TEMP;
 	    stab_val(defstab) = st[src];
+	}
 	else
 	    stab_val(defstab) = str_mortal(&str_undef);
 	(void)eval(arg,G_SCALAR,sp);
@@ -1407,9 +1463,9 @@ static STAB *firststab = Nullstab;
 static STAB *secondstab = Nullstab;
 
 int
-do_sort(str,stab,gimme,arglast)
+do_sort(str,arg,gimme,arglast)
 STR *str;
-STAB *stab;
+ARG *arg;
 int gimme;
 int *arglast;
 {
@@ -1423,6 +1479,7 @@ int *arglast;
     STR *oldfirst;
     STR *oldsecond;
     ARRAY *oldstack;
+    HASH *stash;
     static ARRAY *sortstack = Null(ARRAY*);
 
     if (gimme != G_ARRAY) {
@@ -1434,6 +1491,7 @@ int *arglast;
     up = &st[sp];
     st += sp;		/* temporarily make st point to args */
     for (i = 1; i <= max; i++) {
+	/*SUPPRESS 560*/
 	if (*up = st[i]) {
 	    if (!(*up)->str_pok)
 		(void)str_2ptr(*up);
@@ -1446,11 +1504,31 @@ int *arglast;
     max = up - &st[sp];
     sp--;
     if (max > 1) {
-	if (stab) {
+	STAB *stab;
+
+	if (arg[1].arg_type == (A_CMD|A_DONT)) {
+	    sortcmd = arg[1].arg_ptr.arg_cmd;
+	    stash = curcmd->c_stash;
+	}
+	else {
+	    if ((arg[1].arg_type & A_MASK) == A_WORD)
+		stab = arg[1].arg_ptr.arg_stab;
+	    else
+		stab = stabent(str_get(st[sp+1]),TRUE);
+
+	    if (stab) {
+		if (!stab_sub(stab) || !(sortcmd = stab_sub(stab)->cmd))
+		    fatal("Undefined subroutine \"%s\" in sort", 
+			stab_name(stab));
+		stash = stab_stash(stab);
+	    }
+	    else
+		sortcmd = Nullcmd;
+	}
+
+	if (sortcmd) {
 	    int oldtmps_base = tmps_base;
 
-	    if (!stab_sub(stab) || !(sortcmd = stab_sub(stab)->cmd))
-		fatal("Undefined subroutine \"%s\" in sort", stab_name(stab));
 	    if (!sortstack) {
 		sortstack = anew(Nullstab);
 		astore(sortstack, 0, Nullstr);
@@ -1460,10 +1538,10 @@ int *arglast;
 	    oldstack = stack;
 	    stack = sortstack;
 	    tmps_base = tmps_max;
-	    if (sortstash != stab_stash(stab)) {
+	    if (sortstash != stash) {
 		firststab = stabent("a",TRUE);
 		secondstab = stabent("b",TRUE);
-		sortstash = stab_stash(stab);
+		sortstash = stash;
 	    }
 	    oldfirst = stab_val(firststab);
 	    oldsecond = stab_val(secondstab);
@@ -1505,11 +1583,13 @@ STR **strp2;
     int retval;
 
     if (str1->str_cur < str2->str_cur) {
+	/*SUPPRESS 560*/
 	if (retval = memcmp(str1->str_ptr, str2->str_ptr, str1->str_cur))
 	    return retval;
 	else
 	    return -1;
     }
+    /*SUPPRESS 560*/
     else if (retval = memcmp(str1->str_ptr, str2->str_ptr, str2->str_cur))
 	return retval;
     else if (str1->str_cur == str2->str_cur)
@@ -1537,6 +1617,8 @@ int *arglast;
       (looks_like_number(st[sp+1]) && *st[sp+1]->str_ptr != '0') ) {
 	i = (int)str_gnum(st[sp+1]);
 	max = (int)str_gnum(st[sp+2]);
+	if (max > i)
+	    (void)astore(ary, sp + max - i + 1, Nullstr);
 	while (i <= max) {
 	    (void)astore(ary, ++sp, str = str_mortal(&str_no));
 	    str_numset(str,(double)i++);
@@ -1567,7 +1649,6 @@ int *arglast;
     register int sp = arglast[0];
     register int items = arglast[1] - sp;
     register int count = (int) str_gnum(st[arglast[2]]);
-    register ARRAY *ary = stack;
     register int i;
     int max;
 
@@ -1639,7 +1720,6 @@ int *arglast;
       str_2mortal(str_nmake((double)csv->wantarray)) );
     if (csv->hasargs) {
 	ARRAY *ary = csv->argarray;
-	STAB *tmpstab;
 
 	if (!dbargs)
 	    dbargs = stab_xarray(aadd(stabent("DB'args", TRUE)));
@@ -1750,6 +1830,7 @@ int *arglast;
 	return sp;
     }
     (void)hiterinit(hash);
+    /*SUPPRESS 560*/
     while (entry = hiternext(hash)) {
 	if (dokeys) {
 	    tmps = hiterkey(entry,&i);
diff --git a/eval.c b/eval.c
index 1b3c514654..c8782e2749 100644
--- a/eval.c
+++ b/eval.c
@@ -1,4 +1,4 @@
-/* $RCSfile: eval.c,v $$Revision: 4.0.1.2 $$Date: 91/06/07 11:07:23 $
+/* $RCSfile: eval.c,v $$Revision: 4.0.1.3 $$Date: 91/11/05 17:15:21 $
  *
  *    Copyright (c) 1991, Larry Wall
  *
@@ -6,6 +6,16 @@
  *    License or the Artistic License, as specified in the README file.
  *
  * $Log:	eval.c,v $
+ * Revision 4.0.1.3  91/11/05  17:15:21  lwall
+ * patch11: prepared for ctype implementations that don't define isascii()
+ * patch11: various portability fixes
+ * patch11: added sort {} LIST
+ * patch11: added eval {}
+ * patch11: sysread() in socket was substituting recv()
+ * patch11: a last statement outside any block caused occasional core dumps
+ * patch11: missing arguments caused core dump in -D8 code
+ * patch11: eval 'stuff' now optimized to eval {stuff}
+ * 
  * Revision 4.0.1.2  91/06/07  11:07:23  lwall
  * patch4: new copyright notice
  * patch4: length($`), length($&), length($') now optimized to avoid string copy
@@ -326,6 +336,7 @@ register int sp;
 	    if (fp) {
 		if (gimme == G_SCALAR) {
 		    while (str_gets(str,fp,str->str_cur) != Nullch)
+			/*SUPPRESS 530*/
 			;
 		}
 		else {
@@ -490,7 +501,7 @@ register int sp;
 		    else
 			str->str_cur++;
 		    for (tmps = str->str_ptr; *tmps; tmps++)
-			if (!isalpha(*tmps) && !isdigit(*tmps) &&
+			if (!isALPHA(*tmps) && !isDIGIT(*tmps) &&
 			    index("$&*(){}[]'\";\\|?<>~`",*tmps))
 				break;
 		    if (*tmps && stat(str->str_ptr,&statbuf) < 0)
@@ -694,7 +705,7 @@ register int sp;
     case O_DIVIDE:
 	if ((value = str_gnum(st[2])) == 0.0)
 	    fatal("Illegal division by zero");
-#ifdef cray
+#ifdef SLOPPYDIVIDE
 	/* insure that 20./5. == 4. */
 	{
 	    double x;
@@ -884,7 +895,11 @@ register int sp;
 	value = -str_gnum(st[1]);
 	goto donumset;
     case O_NOT:
+#ifdef NOTNOT
+	{ char xxx = str_true(st[1]); value = (double) !xxx; }
+#else
 	value = (double) !str_true(st[1]);
+#endif
 	goto donumset;
     case O_COMPLEMENT:
 	if (!sawvec || st[1]->str_nok) {
@@ -1179,6 +1194,7 @@ register int sp;
     case O_SUBSTR:
 	anum = ((int)str_gnum(st[2])) - arybase;	/* anum=where to start*/
 	tmps = str_get(st[1]);		/* force conversion to string */
+	/*SUPPRESS 560*/
 	if (argtype = (str == st[1]))
 	    str = arg->arg_ptr.arg_str;
 	if (anum < 0)
@@ -1204,6 +1220,7 @@ register int sp;
 	}
 	break;
     case O_PACK:
+	/*SUPPRESS 701*/
 	(void)do_pack(str,arglast);
 	break;
     case O_GREP:
@@ -1253,11 +1270,7 @@ register int sp;
 	st = stack->ary_array + arglast[0];		/* maybe realloced */
 	goto array_return;
     case O_SORT:
-	if ((arg[1].arg_type & A_MASK) == A_WORD)
-	    stab = arg[1].arg_ptr.arg_stab;
-	else
-	    stab = stabent(str_get(st[1]),TRUE);
-	sp = do_sort(str,stab,
+	sp = do_sort(str,arg,
 	  gimme,arglast);
 	goto array_return;
     case O_REVERSE:
@@ -1451,6 +1464,10 @@ register int sp;
 	    goto badsock;
 #endif
 	STR_GROW(st[2], anum+maxarg+1), (tmps = str_get(st[2]));  /* sneaky */
+	if (optype == O_SYSREAD) {
+	    anum = read(fileno(stab_io(stab)->ifp), tmps+maxarg, anum);
+	}
+	else
 #ifdef HAS_SOCKET
 	if (stab_io(stab)->type == 's') {
 	    argtype = sizeof buf;
@@ -1459,10 +1476,6 @@ register int sp;
 	}
 	else
 #endif
-	if (optype == O_SYSREAD) {
-	    anum = read(fileno(stab_io(stab)->ifp), tmps+maxarg, anum);
-	}
-	else
 	    anum = fread(tmps+maxarg, 1, anum, stab_io(stab)->ifp);
 	if (anum < 0)
 	    goto say_undef;
@@ -1541,6 +1554,7 @@ register int sp;
     case O_REDO:
     case O_NEXT:
     case O_LAST:
+	tmps = Nullch;
 	if (maxarg > 0) {
 	    tmps = str_get(arg[1].arg_ptr.arg_str);
 	  dopop:
@@ -1887,9 +1901,10 @@ register int sp;
 	if (anum < 0)
 	    goto say_undef;
 	if (!anum) {
+	    /*SUPPRESS 560*/
 	    if (tmpstab = stabent("$",allstabs))
 		str_numset(STAB_STR(tmpstab),(double)getpid());
-	    hclear(pidstatus);	/* no kids, so don't wait for 'em */
+	    hclear(pidstatus, FALSE);	/* no kids, so don't wait for 'em */
 	}
 	value = (double)anum;
 	goto donumset;
@@ -2005,7 +2020,7 @@ register int sp;
 	    tmps = str_get(stab_val(defstab));
 	else
 	    tmps = str_get(st[1]);
-	while (*tmps && isascii(*tmps) && (isspace(*tmps) || *tmps == '0'))
+	while (*tmps && (isSPACE(*tmps) || *tmps == '0'))
 	    tmps++;
 	if (*tmps == 'x')
 	    value = (double)scanhex(++tmps, 99, &argtype);
@@ -2014,7 +2029,7 @@ register int sp;
 	goto donumset;
 
 /* These common exits are hidden here in the middle of the switches for the
-/* benefit of those machines with limited branch addressing.  Sigh.  */
+   benefit of those machines with limited branch addressing.  Sigh.  */
 
 array_return:
 #ifdef DEBUGGING
@@ -2027,12 +2042,14 @@ array_return:
 		deb("%s RETURNS ()\n",opname[optype]);
 		break;
 	    case 1:
-		deb("%s RETURNS (\"%s\")\n",opname[optype],str_get(st[1]));
+		deb("%s RETURNS (\"%s\")\n",opname[optype],
+		    st[1] ? str_get(st[1]) : "");
 		break;
 	    default:
-		tmps = str_get(st[1]);
+		tmps = st[1] ? str_get(st[1]) : "";
 		deb("%s RETURNS %d ARGS (\"%s\",%s\"%s\")\n",opname[optype],
-		  anum,tmps,anum==2?"":"...,",str_get(st[anum]));
+		  anum,tmps,anum==2?"":"...,",
+			st[anum] ? str_get(st[anum]) : "");
 		break;
 	    }
 	}
@@ -2410,6 +2427,22 @@ donumset:
 	value = (double)(ary->ary_fill + 1);
 	goto donumset;
 
+    case O_TRY:
+	sp = do_try(arg[1].arg_ptr.arg_cmd,
+	    gimme,arglast);
+	goto array_return;
+
+    case O_EVALONCE:
+	sp = do_eval(st[1], O_EVAL, curcmd->c_stash, TRUE,
+	    gimme,arglast);
+	if (eval_root) {
+	    str_free(arg[1].arg_ptr.arg_str);
+	    arg[1].arg_ptr.arg_cmd = eval_root;
+	    arg[1].arg_type = (A_CMD|A_DONT);
+	    arg[0].arg_type = O_TRY;
+	}
+	goto array_return;
+
     case O_REQUIRE:
     case O_DOFILE:
     case O_EVAL:
@@ -2422,7 +2455,7 @@ donumset:
 	tainted |= tmpstr->str_tainted;
 	taintproper("Insecure dependency in eval");
 #endif
-	sp = do_eval(tmpstr, optype, curcmd->c_stash,
+	sp = do_eval(tmpstr, optype, curcmd->c_stash, FALSE,
 	    gimme,arglast);
 	goto array_return;
 
@@ -2598,7 +2631,7 @@ donumset:
 	    stab = stabent(tmps = str_get(st[1]),FALSE);
 	if (stab && stab_io(stab) && stab_io(stab)->ifp)
 	    anum = fileno(stab_io(stab)->ifp);
-	else if (isdigit(*tmps))
+	else if (isDIGIT(*tmps))
 	    anum = atoi(tmps);
 	else
 	    goto say_undef;
diff --git a/lib/exceptions.pl b/lib/exceptions.pl
new file mode 100644
index 0000000000..02c4498d32
--- /dev/null
+++ b/lib/exceptions.pl
@@ -0,0 +1,54 @@
+# exceptions.pl
+# tchrist@convex.com
+# 
+# Here's a little code I use for exception handling.  It's really just
+# glorfied eval/die.  The way to use use it is when you might otherwise
+# exit, use &throw to raise an exception.  The first enclosing &catch
+# handler looks at the exception and decides whether it can catch this kind
+# (catch takes a list of regexps to catch), and if so, it returns the one it
+# caught.  If it *can't* catch it, then it will reraise the exception
+# for someone else to possibly see, or to die otherwise.
+# 
+# I use oddly named variables in order to make darn sure I don't conflict 
+# with my caller.  I also hide in my own package, and eval the code in his.
+# 
+# The EXCEPTION: prefix is so you can tell whether it's a user-raised
+# exception or a perl-raised one (eval error).
+# 
+# --tom
+#
+# examples:
+#	if (&catch('/$user_input/', 'regexp', 'syntax error') {
+#		warn "oops try again";
+#		redo;
+#	}
+#
+#	if ($error = &catch('&subroutine()')) { # catches anything
+#
+#	&throw('bad input') if /^$/;
+
+sub catch {
+    package exception;
+    local($__code__, @__exceptions__) = @_;
+    local($__package__) = caller;
+    local($__exception__);
+
+    eval "package $__package__; $__code__";
+    if ($__exception__ = &'thrown) {
+	for (@__exceptions__) {
+	    return $__exception__ if /$__exception__/;
+	} 
+	&'throw($__exception__);
+    } 
+} 
+
+sub throw {
+    local($exception) = @_;
+    die "EXCEPTION: $exception\n";
+} 
+
+sub thrown {
+    $@ =~ /^(EXCEPTION: )+(.+)/ && $2;
+} 
+
+1;
diff --git a/lib/fastcwd.pl b/lib/fastcwd.pl
new file mode 100644
index 0000000000..6b452e8d78
--- /dev/null
+++ b/lib/fastcwd.pl
@@ -0,0 +1,35 @@
+# By John Bazik
+#
+# Usage: $cwd = &fastcwd;
+#
+# This is a faster version of getcwd.  It's also more dangerous because
+# you might chdir out of a directory that you can't chdir back into.
+
+sub fastcwd {
+	local($odev, $oino, $cdev, $cino, $tdev, $tino);
+	local(@path, $path);
+	local(*DIR);
+
+	($cdev, $cino) = stat('.');
+	for (;;) {
+		($odev, $oino) = ($cdev, $cino);
+		chdir('..');
+		($cdev, $cino) = stat('.');
+		last if $odev == $cdev && $oino == $cino;
+		opendir(DIR, '.');
+		for (;;) {
+			$_ = readdir(DIR);
+			next if $_ eq '.';
+			next if $_ eq '..';
+
+			last unless $_;
+			($tdev, $tino) = lstat($_);
+			last unless $tdev != $odev || $tino != $oino;
+		}
+		closedir(DIR);
+		unshift(@path, $_);
+	}
+	chdir($path = '/' . join('/', @path));
+	$path;
+}
+1;
diff --git a/patchlevel.h b/patchlevel.h
index 910cae8f16..f95be0eb07 100644
--- a/patchlevel.h
+++ b/patchlevel.h
@@ -1 +1 @@
-#define PATCHLEVEL 13
+#define PATCHLEVEL 14
diff --git a/t/op/eval.t b/t/op/eval.t
index 464162c0a3..7bca608137 100644
--- a/t/op/eval.t
+++ b/t/op/eval.t
@@ -1,8 +1,8 @@
 #!./perl
 
-# $Header: eval.t,v 4.0 91/03/20 01:52:20 lwall Locked $
+# $RCSfile: eval.t,v $$Revision: 4.0.1.1 $$Date: 91/11/05 18:43:19 $
 
-print "1..10\n";
+print "1..16\n";
 
 eval 'print "ok 1\n";';
 
@@ -40,3 +40,18 @@ print try 'print "ok 10\n"; unlink "Op.eval";',"\n";
 close try;
 
 do 'Op.eval'; print $@;
+
+# Test the singlequoted eval optimizer
+
+$i = 11;
+for (1..3) {
+    eval 'print "ok ", $i++, "\n"';
+}
+
+eval {
+    print "ok 14\n";
+    die "ok 16\n";
+    1;
+} || print "ok 15\n$@";
+
+
diff --git a/x2p/find2perl.SH b/x2p/find2perl.SH
index 9161f7ba98..032db6b6e0 100644
--- a/x2p/find2perl.SH
+++ b/x2p/find2perl.SH
@@ -96,7 +96,7 @@ while (@ARGV) {
     }
     elsif ($_ eq 'group') {
 	$gname = shift;
-	$out .= &tab . "\$gid == \$gid('$gname')";
+	$out .= &tab . "\$gid == \$gid{'$gname'}";
 	$initgroup++;
     }
     elsif ($_ eq 'nouser') {
@@ -381,7 +381,7 @@ sub cpio {
 	($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
 	  $atime,$mtime,$ctime,$blksize,$blocks) = lstat(_);
 	if (-f _) {
-	    open(IN, $_) || do {
+	    open(IN, "./$_\0") || do {
 		warn "Couldn't open $name: $!\n";
 		return;
 	    };
@@ -471,7 +471,7 @@ sub tar {
 	}
     }
     if (-f _) {
-	open(IN, $_) || do {
+	open(IN, "./$_\0") || do {
 	    warn "Couldn't open $name: $!\n";
 	    return;
 	};