perl 3.0 patch #10 patch #9, continued

See patch #9.

12 files changed, 322 insertions, 116 deletions

diff --git a/cmd.c b/cmd.c
index 36c36bd039..be03fe069e 100644
--- a/cmd.c
+++ b/cmd.c
@@ -1,4 +1,4 @@
-/* $Header: cmd.c,v 3.0.1.4 89/12/21 19:17:41 lwall Locked $
+/* $Header: cmd.c,v 3.0.1.5 90/02/28 16:38:31 lwall Locked $
  *
  *    Copyright (c) 1989, Larry Wall
  *
@@ -6,6 +6,14 @@
  *    as specified in the README file that comes with the perl 3.0 kit.
  *
  * $Log:	cmd.c,v $
+ * Revision 3.0.1.5  90/02/28  16:38:31  lwall
+ * patch9: volatilized some more variables for super-optimizing compilers
+ * patch9: nested foreach loops didn't reset inner loop on next to outer loop
+ * patch9: returned values were read from obsolete stack
+ * patch9: added sanity check on longjmp() return value
+ * patch9: substitutions that almost always succeed can corrupt label stack
+ * patch9: subs which return by both mechanisms can clobber local return data
+ * 
  * Revision 3.0.1.4  89/12/21  19:17:41  lwall
  * patch7: arranged for certain registers to be restored after longjmp()
  * patch7: made nested or recursive foreach work right
@@ -50,11 +58,12 @@ void grow_dlevel();
 int
 cmd_exec(cmdparm,gimme,sp)
 CMD *VOLATILE cmdparm;
-int gimme;
-int sp;
+VOLATILE int gimme;
+VOLATILE int sp;
 {
     register CMD *cmd = cmdparm;
     SPAT *VOLATILE oldspat;
+    VOLATILE int firstsave = savestack->ary_fill;
     VOLATILE int oldsave;
     VOLATILE int aryoptsave;
 #ifdef DEBUGGING
@@ -178,12 +187,16 @@ tail_recursion_entry:
 		cmdparm = cmd;
 #endif
 		if (match = setjmp(loop_stack[loop_ptr].loop_env)) {
-#ifdef JMPCLOBBER
 		    st = stack->ary_array;	/* possibly reallocated */
+#ifdef JMPCLOBBER
 		    cmd = cmdparm;
 		    cmdflags = cmd->c_flags|CF_ONCE;
 #endif
+		    if (savestack->ary_fill > oldsave)
+			restorelist(oldsave);
 		    switch (match) {
+		    default:
+			fatal("longjmp returned bad value (%d)",match);
 		    case O_LAST:	/* not done unless go_to found */
 			go_to = Nullch;
 			if (lastretstr) {
@@ -198,8 +211,6 @@ tail_recursion_entry:
 			olddlevel = dlevel;
 #endif
 			curspat = oldspat;
-			if (savestack->ary_fill > oldsave)
-			    restorelist(oldsave);
 			goto next_cmd;
 		    case O_NEXT:	/* not done unless go_to found */
 			go_to = Nullch;
@@ -450,7 +461,7 @@ until_loop:
 		}
 	    }
 	    if (--cmd->c_short->str_u.str_useful < 0) {
-		cmdflags &= ~CF_OPTIMIZE;
+		cmdflags &= ~(CF_OPTIMIZE|CF_ONCE);
 		cmdflags |= CFT_EVAL;	/* never try this optimization again */
 		cmd->c_flags = cmdflags;
 	    }
@@ -563,8 +574,11 @@ until_loop:
 		savesptr(&stab_val(cmd->c_stab));
 		savelong(&cmd->c_short->str_u.str_useful);
 	    }
-	    else
+	    else {
 		ar = stab_xarray(cmd->c_expr[1].arg_ptr.arg_stab);
+		if (cmd->c_type != C_WHILE && savestack->ary_fill > firstsave)
+		    restorelist(firstsave);
+	    }
 
 	    if (match >= ar->ary_fill) {	/* we're in LAST, probably */
 		retstr = &str_undef;
@@ -753,13 +767,17 @@ until_loop:
 	cmdparm = cmd;
 #endif
 	if (match = setjmp(loop_stack[loop_ptr].loop_env)) {
-#ifdef JMPCLOBBER
 	    st = stack->ary_array;	/* possibly reallocated */
+#ifdef JMPCLOBBER
 	    cmd = cmdparm;
 	    cmdflags = cmd->c_flags|CF_ONCE;
 	    go_to = goto_targ;
 #endif
+	    if (savestack->ary_fill > oldsave)
+		restorelist(oldsave);
 	    switch (match) {
+	    default:
+		fatal("longjmp returned bad value (%d)",match);
 	    case O_LAST:
 		if (lastretstr) {
 		    retstr = lastretstr;
@@ -770,8 +788,6 @@ until_loop:
 		    retstr = st[newsp];
 		}
 		curspat = oldspat;
-		if (savestack->ary_fill > oldsave)
-		    restorelist(oldsave);
 		goto next_cmd;
 	    case O_NEXT:
 #ifdef JMPCLOBBER
@@ -831,8 +847,14 @@ until_loop:
 	}
       finish_while:
 	curspat = oldspat;
-	if (savestack->ary_fill > oldsave)
+	if (savestack->ary_fill > oldsave) {
+	    if (cmdflags & CF_TERM) {
+		for (match = sp + 1; match <= newsp; match++)
+		    st[match] = str_static(st[match]);
+		retstr = st[newsp];
+	    }
 	    restorelist(oldsave);
+	}
 #ifdef DEBUGGING
 	dlevel = olddlevel - 1;
 #endif
@@ -855,7 +877,8 @@ until_loop:
 	}
 #endif
 	loop_ptr--;
-	if ((cmdflags & CF_OPTIMIZE) == CFT_ARRAY)
+	if ((cmdflags & CF_OPTIMIZE) == CFT_ARRAY &&
+	  savestack->ary_fill > aryoptsave)
 	    restorelist(aryoptsave);
     }
     cmd = cmd->c_next;
diff --git a/cmd.h b/cmd.h
index 3a1d832353..0c4a0b8b60 100644
--- a/cmd.h
+++ b/cmd.h
@@ -1,4 +1,4 @@
-/* $Header: cmd.h,v 3.0.1.1 89/10/26 23:05:43 lwall Locked $
+/* $Header: cmd.h,v 3.0.1.2 90/02/28 16:39:36 lwall Locked $
  *
  *    Copyright (c) 1989, Larry Wall
  *
@@ -6,6 +6,9 @@
  *    as specified in the README file that comes with the perl 3.0 kit.
  *
  * $Log:	cmd.h,v $
+ * Revision 3.0.1.2  90/02/28  16:39:36  lwall
+ * patch9: volatilized some more variables for super-optimizing compilers
+ * 
  * Revision 3.0.1.1  89/10/26  23:05:43  lwall
  * patch1: unless was broken when run under the debugger
  * 
@@ -127,7 +130,7 @@ struct cmd {
 	struct scmd scmd;	/* switch command */
     } ucmd;
     short	c_slen;		/* len of c_short, if not null */
-    short	c_flags;	/* optimization flags--see above */
+    VOLATILE short c_flags;	/* optimization flags--see above */
     char	*c_file;	/* file the following line # is from */
     line_t      c_line;         /* line # of this command */
     char	c_type;		/* what this command does */
@@ -135,8 +138,8 @@ struct cmd {
 
 #define Nullcmd Null(CMD*)
 
-EXT CMD *main_root INIT(Nullcmd);
-EXT CMD *eval_root INIT(Nullcmd);
+EXT CMD * VOLATILE main_root INIT(Nullcmd);
+EXT CMD * VOLATILE eval_root INIT(Nullcmd);
 
 struct compcmd {
     CMD *comp_true;
diff --git a/config.h.SH b/config.h.SH
index af686c6613..7215ef9f08 100644
--- a/config.h.SH
+++ b/config.h.SH
@@ -422,6 +422,12 @@ sed <<!GROK!THIS! >config.h -e 's!^#undef!/\*#undef!'
  */
 #$d_voidsig	VOIDSIG 	/**/
 
+/* HASVOLATILE:
+ *	This symbol, if defined, indicates that this C compiler knows about
+ *	the volatile declaration.
+ */
+#$d_volatile	HASVOLATILE	/**/
+
 /* VPRINTF:
  *	This symbol, if defined, indicates that the vprintf routine is available
  *	to printf with a pointer to an argument list.  If unavailable, you
@@ -542,7 +548,7 @@ sed <<!GROK!THIS! >config.h -e 's!^#undef!/\*#undef!'
 
 /* I_UTIME:
  *	This symbol, if defined, indicates to the C program that it should
- *	include utime.h (a DG/UX thingie).
+ *	include utime.h.
  */
 #$i_utime	I_UTIME		/**/
 
diff --git a/cons.c b/cons.c
index 6db876cf44..28b6ddffe9 100644
--- a/cons.c
+++ b/cons.c
@@ -1,4 +1,4 @@
-/* $Header: cons.c,v 3.0.1.3 89/12/21 19:20:25 lwall Locked $
+/* $Header: cons.c,v 3.0.1.4 90/02/28 16:44:00 lwall Locked $
  *
  *    Copyright (c) 1989, Larry Wall
  *
@@ -6,6 +6,11 @@
  *    as specified in the README file that comes with the perl 3.0 kit.
  *
  * $Log:	cons.c,v $
+ * Revision 3.0.1.4  90/02/28  16:44:00  lwall
+ * patch9: subs which return by both mechanisms can clobber local return data
+ * patch9: changed internal SUB label to _SUB_
+ * patch9: line numbers were bogus during certain portions of foreach evaluation
+ * 
  * Revision 3.0.1.3  89/12/21  19:20:25  lwall
  * patch7: made nested or recursive foreach work right
  * 
@@ -67,8 +72,12 @@ CMD *cmd;
 
 	mycompblock.comp_true = cmd;
 	mycompblock.comp_alt = Nullcmd;
-	cmd = add_label(savestr("SUB"),make_ccmd(C_BLOCK,Nullarg,mycompblock));
+	cmd = add_label(savestr("_SUB_"),make_ccmd(C_BLOCK,Nullarg,mycompblock));
 	saw_return = FALSE;
+	if (perldb)
+	    cmd->c_next->c_flags |= CF_TERM;
+	else
+	    cmd->c_flags |= CF_TERM;
     }
     sub->cmd = cmd;
     stab_sub(stab) = sub;
@@ -412,7 +421,9 @@ ARG *arg;
     cmd->c_expr = cond;
     if (cond)
 	cmd->c_flags |= CF_COND;
-    if (cmdline != NOLINE) {
+    if (cmdline == NOLINE)
+	cmd->c_line = line;
+    else {
 	cmd->c_line = cmdline;
 	cmdline = NOLINE;
     }
@@ -437,7 +448,9 @@ struct compcmd cblock;
     cmd->ucmd.ccmd.cc_alt = cblock.comp_alt;
     if (arg)
 	cmd->c_flags |= CF_COND;
-    if (cmdline != NOLINE) {
+    if (cmdline == NOLINE)
+	cmd->c_line = line;
+    else {
 	cmd->c_line = cmdline;
 	cmdline = NOLINE;
     }
@@ -466,7 +479,9 @@ struct compcmd cblock;
     cmd->ucmd.ccmd.cc_alt = cblock.comp_alt;
     if (arg)
 	cmd->c_flags |= CF_COND;
-    if (cmdline != NOLINE) {
+    if (cmdline == NOLINE)
+	cmd->c_line = line;
+    else {
 	cmd->c_line = cmdline;
 	cmdline = NOLINE;
     }
diff --git a/consarg.c b/consarg.c
index 6feeb9b5a1..4252ad57c4 100644
--- a/consarg.c
+++ b/consarg.c
@@ -1,4 +1,4 @@
-/* $Header: consarg.c,v 3.0.1.2 89/11/17 15:11:34 lwall Locked $
+/* $Header: consarg.c,v 3.0.1.3 90/02/28 16:47:54 lwall Locked $
  *
  *    Copyright (c) 1989, Larry Wall
  *
@@ -6,6 +6,10 @@
  *    as specified in the README file that comes with the perl 3.0 kit.
  *
  * $Log:	consarg.c,v $
+ * Revision 3.0.1.3  90/02/28  16:47:54  lwall
+ * patch9: the x operator is now up to 10 times faster
+ * patch9: @_ clobbered by ($foo,$bar) = split
+ * 
  * Revision 3.0.1.2  89/11/17  15:11:34  lwall
  * patch5: defined $foo{'bar'} should not create element
  * 
@@ -312,9 +316,12 @@ register ARG *arg;
 	    break;
 	case O_REPEAT:
 	    i = (int)str_gnum(s2);
+	    tmps = str_get(s1);
 	    str_nset(str,"",0);
-	    while (i-- > 0)
-		str_scat(str,s1);
+	    STR_GROW(str, i * s1->str_cur + 1);
+	    repeatcpy(str->str_ptr, tmps, s1->str_cur, i);
+	    str->str_cur = i * s1->str_cur;
+	    str->str_ptr[str->str_cur] = '\0';
 	    break;
 	case O_MULTIPLY:
 	    value = str_gnum(s1);
@@ -648,10 +655,11 @@ register ARG *arg;
 		arg2 = arg[2].arg_ptr.arg_arg;
 		if (arg2->arg_type == O_SPLIT) { /* use split's builtin =?*/
 		    spat = arg2[2].arg_ptr.arg_spat;
-		    if (spat->spat_repl[1].arg_ptr.arg_stab == defstab &&
+		    if (!(spat->spat_flags & SPAT_ONCE) &&
 		      nothing_in_common(arg1,spat->spat_repl)) {
 			spat->spat_repl[1].arg_ptr.arg_stab =
 			    arg1[1].arg_ptr.arg_stab;
+			spat->spat_flags |= SPAT_ONCE;
 			arg_free(arg1);	/* recursive */
 			free_arg(arg);	/* non-recursive */
 			return arg2;	/* split has builtin assign */
diff --git a/doarg.c b/doarg.c
index 7e7bfc89d4..43d945f4a9 100644
--- a/doarg.c
+++ b/doarg.c
@@ -1,4 +1,4 @@
-/* $Header: doarg.c,v 3.0.1.2 89/12/21 19:52:15 lwall Locked $
+/* $Header: doarg.c,v 3.0.1.3 90/02/28 16:56:58 lwall Locked $
  *
  *    Copyright (c) 1989, Larry Wall
  *
@@ -6,6 +6,15 @@
  *    as specified in the README file that comes with the perl 3.0 kit.
  *
  * $Log:	doarg.c,v $
+ * Revision 3.0.1.3  90/02/28  16:56:58  lwall
+ * patch9: split now can split into more than 10000 elements
+ * patch9: sped up pack and unpack
+ * patch9: pack of unsigned ints and longs blew up some places
+ * patch9: sun3 can't cast negative float to unsigned int or long
+ * patch9: local($.) didn't work
+ * patch9: grep(s/foo/bar/, @abc = @xyz) modified @xyz rather than @abc
+ * patch9: syscall returned stack size rather than value of system call
+ * 
  * Revision 3.0.1.2  89/12/21  19:52:15  lwall
  * patch7: a pattern wouldn't match a null string before the first character
  * patch7: certain patterns didn't match correctly at end of string
@@ -44,6 +53,7 @@ int sp;
     register char *d;
     int clen;
     int iters = 0;
+    int maxiters = (strend - s) + 10;
     register int i;
     bool once;
     char *orig;
@@ -192,7 +202,7 @@ int sp;
 		    /* NOTREACHED */
 		}
 		do {
-		    if (iters++ > 10000)
+		    if (iters++ > maxiters)
 			fatal("Substitution loop");
 		    m = spat->spat_regexp->startp[0];
 		    if (i = m - s) {
@@ -233,7 +243,7 @@ int sp;
 	    curspat = spat;
 	lastspat = spat;
 	do {
-	    if (iters++ > 10000)
+	    if (iters++ > maxiters)
 		fatal("Substitution loop");
 	    if (spat->spat_regexp->subbase
 	      && spat->spat_regexp->subbase != orig) {
@@ -351,7 +361,9 @@ int *arglast;
     char achar;
     short ashort;
     int aint;
+    unsigned int auint;
     long along;
+    unsigned long aulong;
     char *aptr;
 
     items = arglast[2] - sp;
@@ -361,9 +373,9 @@ int *arglast;
 #define NEXTFROM (items-- > 0 ? *st++ : &str_no)
 	datumtype = *pat++;
 	if (isdigit(*pat)) {
-	    len = atoi(pat);
+	    len = *pat++ - '0';
 	    while (isdigit(*pat))
-		pat++;
+		len = (len * 10) + (*pat++ - '0');
 	}
 	else
 	    len = 1;
@@ -429,6 +441,12 @@ int *arglast;
 	    }
 	    break;
 	case 'I':
+	    while (len-- > 0) {
+		fromstr = NEXTFROM;
+		auint = (unsigned int)str_gnum(fromstr);
+		str_ncat(str,(char*)&auint,sizeof(unsigned int));
+	    }
+	    break;
 	case 'i':
 	    while (len-- > 0) {
 		fromstr = NEXTFROM;
@@ -447,6 +465,12 @@ int *arglast;
 	    }
 	    break;
 	case 'L':
+	    while (len-- > 0) {
+		fromstr = NEXTFROM;
+		aulong = (unsigned long)str_gnum(fromstr);
+		str_ncat(str,(char*)&aulong,sizeof(unsigned long));
+	    }
+	    break;
 	case 'l':
 	    while (len-- > 0) {
 		fromstr = NEXTFROM;
@@ -481,6 +505,7 @@ register STR **sarg;
     register char *send;
     char *xs;
     int xlen;
+    double value;
 
     str_set(str,"");
     len--;			/* don't count pattern string */
@@ -547,10 +572,20 @@ register STR **sarg;
 	    case 'x': case 'o': case 'u':
 		ch = *(++t);
 		*t = '\0';
+		value = str_gnum(*(sarg++));
+#if defined(sun) && !defined(sparc)
+		if (value < 0.0) {		/* sigh */
+		    if (dolong)
+			(void)sprintf(buf,s,(long)value);
+		    else
+			(void)sprintf(buf,s,(int)value);
+		}
+		else
+#endif
 		if (dolong)
-		    (void)sprintf(buf,s,(unsigned long)str_gnum(*(sarg++)));
+		    (void)sprintf(buf,s,(unsigned long)value);
 		else
-		    (void)sprintf(buf,s,(unsigned int)str_gnum(*(sarg++)));
+		    (void)sprintf(buf,s,(unsigned int)value);
 		s = t;
 		*(t--) = ch;
 		break;
@@ -798,6 +833,7 @@ int *arglast;
     int i;
 
     makelocal = (arg->arg_flags & AF_LOCAL);
+    localizing = makelocal;
     delaymagic = DM_DELAY;		/* catch simultaneous items */
 
     /* If there's a common identifier on both sides we have to take
@@ -828,9 +864,8 @@ int *arglast;
 		while (relem <= lastrelem) {	/* gobble up all the rest */
 		    str = Str_new(28,0);
 		    if (*relem)
-			str_sset(str,*(relem++));
-		    else
-			relem++;
+			str_sset(str,*relem);
+		    *(relem++) = str;
 		    (void)astore(ary,i++,str);
 		}
 	    }
@@ -852,9 +887,8 @@ int *arglast;
 		    tmps = str_get(str);
 		    tmpstr = Str_new(29,0);
 		    if (*relem)
-			str_sset(tmpstr,*(relem++));	/* value */
-		    else
-			relem++;
+			str_sset(tmpstr,*relem);	/* value */
+		    *(relem++) = tmpstr;
 		    (void)hstore(hash,tmps,str->str_cur,tmpstr,0);
 		}
 	    }
@@ -864,10 +898,26 @@ int *arglast;
 	else {
 	    if (makelocal)
 		saveitem(str);
-	    if (relem <= lastrelem)
-		str_sset(str, *(relem++));
-	    else
+	    if (relem <= lastrelem) {
+		str_sset(str, *relem);
+		*(relem++) = str;
+	    }
+	    else {
 		str_nset(str, "", 0);
+		if (gimme == G_ARRAY) {
+		    i = ++lastrelem - firstrelem;
+		    relem++;		/* tacky, I suppose */
+		    astore(stack,i,str);
+		    if (st != stack->ary_array) {
+			st = stack->ary_array;
+			firstrelem = st + arglast[1] + 1;
+			firstlelem = st + arglast[0] + 1;
+			lastlelem = st + arglast[1];
+			lastrelem = st + i;
+			relem = lastrelem + 1;
+		    }
+		}
+	    }
 	    STABSET(str);
 	}
     }
@@ -882,6 +932,7 @@ int *arglast;
 #endif
     }
     delaymagic = 0;
+    localizing = FALSE;
     if (gimme == G_ARRAY) {
 	i = lastrelem - firstrelem + 1;
 	if (ary || hash)
@@ -1283,9 +1334,7 @@ int *arglast;
 	  arg[7]);
 	break;
     }
-    st[sp] = str_static(&str_undef);
-    str_numset(st[sp], (double)retval);
-    return sp;
+    return retval;
 #else
     fatal("syscall() unimplemented");
 #endif
diff --git a/doio.c b/doio.c
index 853347a53f..766d1205e6 100644
--- a/doio.c
+++ b/doio.c
@@ -1,4 +1,4 @@
-/* $Header: doio.c,v 3.0.1.4 89/12/21 19:55:10 lwall Locked $
+/* $Header: doio.c,v 3.0.1.5 90/02/28 17:01:36 lwall Locked $
  *
  *    Copyright (c) 1989, Larry Wall
  *
@@ -6,6 +6,12 @@
  *    as specified in the README file that comes with the perl 3.0 kit.
  *
  * $Log:	doio.c,v $
+ * Revision 3.0.1.5  90/02/28  17:01:36  lwall
+ * patch9: open(FOO,"$filename\0") will now protect trailing spaces in filename
+ * patch9: removed obsolete checks to avoid opening block devices
+ * patch9: removed references to acusec and modusec that some utime.h's have
+ * patch9: added pipe function
+ * 
  * Revision 3.0.1.4  89/12/21  19:55:10  lwall
  * patch7: select now works on big-endian machines
  * patch7: errno may now be a macro with an lvalue
@@ -53,12 +59,12 @@
 #endif
 
 bool
-do_open(stab,name)
+do_open(stab,name,len)
 STAB *stab;
 register char *name;
+int len;
 {
     FILE *fp;
-    int len = strlen(name);
     register STIO *stio = stab_io(stab);
     char *myname = savestr(name);
     int result;
@@ -202,21 +208,6 @@ register char *name;
 	    return FALSE;
 	}
 	result = (statbuf.st_mode & S_IFMT);
-	if (result != S_IFREG &&
-#ifdef S_IFSOCK
-	    result != S_IFSOCK &&
-#endif
-#ifdef S_IFFIFO
-	    result != S_IFFIFO &&
-#endif
-#ifdef S_IFIFO
-	    result != S_IFIFO &&
-#endif
-	    result != 0 &&		/* socket? */
-	    result != S_IFCHR) {
-	    (void)fclose(fp);
-	    return FALSE;
-	}
 #ifdef S_IFSOCK
 	if (result == S_IFSOCK || result == 0)
 	    stio->type = 's';	/* in case a socket was passed in to us */
@@ -250,7 +241,7 @@ register STAB *stab;
 	str_sset(stab_val(stab),str);
 	STABSET(stab_val(stab));
 	oldname = str_get(stab_val(stab));
-	if (do_open(stab,oldname)) {
+	if (do_open(stab,oldname,stab_val(stab)->str_cur)) {
 	    if (inplace) {
 #ifdef TAINT
 		taintproper("Insecure dependency in inplace open");
@@ -275,7 +266,7 @@ register STAB *stab;
 		str_nset(str,">",1);
 		str_cat(str,oldname);
 		errno = 0;		/* in case sprintf set errno */
-		if (!do_open(argvoutstab,str->str_ptr))
+		if (!do_open(argvoutstab,str->str_ptr,str->str_cur))
 		    fatal("Can't do inplace edit");
 		defoutstab = argvoutstab;
 #ifdef FCHMOD
@@ -303,6 +294,49 @@ register STAB *stab;
     return Nullfp;
 }
 
+void
+do_pipe(str, rstab, wstab)
+STR *str;
+STAB *rstab;
+STAB *wstab;
+{
+    register STIO *rstio;
+    register STIO *wstio;
+    int fd[2];
+
+    if (!rstab)
+	goto badexit;
+    if (!wstab)
+	goto badexit;
+
+    rstio = stab_io(rstab);
+    wstio = stab_io(wstab);
+
+    if (!rstio)
+	rstio = stab_io(rstab) = stio_new();
+    else if (rstio->ifp)
+	do_close(rstab,FALSE);
+    if (!wstio)
+	wstio = stab_io(wstab) = stio_new();
+    else if (wstio->ifp)
+	do_close(wstab,FALSE);
+
+    if (pipe(fd) < 0)
+	goto badexit;
+    rstio->ifp = fdopen(fd[0], "r");
+    wstio->ofp = fdopen(fd[1], "w");
+    wstio->ifp = wstio->ofp;
+    rstio->type = '<';
+    wstio->type = '>';
+
+    str_sset(str,&str_yes);
+    return;
+
+badexit:
+    str_sset(str,&str_undef);
+    return;
+}
+
 bool
 do_close(stab,explicit)
 STAB *stab;
@@ -1991,12 +2025,9 @@ int *arglast;
 	    } utbuf;
 #endif
 
+	    Zero(&utbuf, sizeof utbuf, char);
 	    utbuf.actime = (long)str_gnum(st[++sp]);    /* time accessed */
 	    utbuf.modtime = (long)str_gnum(st[++sp]);    /* time modified */
-#ifdef I_UTIME
-	    utbuf.acusec = 0;		/* hopefully I_UTIME implies these */
-	    utbuf.modusec = 0;
-#endif
 	    items -= 2;
 #ifndef lint
 	    tot = items;
diff --git a/dolist.c b/dolist.c
index 4823231030..bd7db0bc2b 100644
--- a/dolist.c
+++ b/dolist.c
@@ -1,4 +1,4 @@
-/* $Header: dolist.c,v 3.0.1.4 89/12/21 19:58:46 lwall Locked $
+/* $Header: dolist.c,v 3.0.1.5 90/02/28 17:09:44 lwall Locked $
  *
  *    Copyright (c) 1989, Larry Wall
  *
@@ -6,6 +6,15 @@
  *    as specified in the README file that comes with the perl 3.0 kit.
  *
  * $Log:	dolist.c,v $
+ * Revision 3.0.1.5  90/02/28  17:09:44  lwall
+ * patch9: split now can split into more than 10000 elements
+ * patch9: @_ clobbered by ($foo,$bar) = split
+ * patch9: sped up pack and unpack
+ * patch9: unpack of single item now works in a scalar context
+ * patch9: slices ignored value of $[
+ * patch9: grep now returns number of items matched in scalar context
+ * patch9: grep iterations no longer in the regexp context of previous iteration
+ * 
  * Revision 3.0.1.4  89/12/21  19:58:46  lwall
  * patch7: grep(1,@array) didn't work
  * patch7: /$pat/; //; wrongly freed runtime pattern twice
@@ -264,6 +273,7 @@ int *arglast;
     register STR *dstr;
     register char *m;
     int iters = 0;
+    int maxiters = (strend - s) + 10;
     int i;
     char *orig;
     int origlimit = limit;
@@ -299,7 +309,7 @@ int *arglast;
     }
 #endif
     ary = stab_xarray(spat->spat_repl[1].arg_ptr.arg_stab);
-    if (ary && ((ary->ary_flags & ARF_REAL) || gimme != G_ARRAY)) {
+    if (ary && (gimme != G_ARRAY || (spat->spat_flags & SPAT_ONCE))) {
 	realarray = 1;
 	if (!(ary->ary_flags & ARF_REAL)) {
 	    ary->ary_flags |= ARF_REAL;
@@ -317,7 +327,7 @@ int *arglast;
 	    s++;
     }
     if (!limit)
-	limit = 10001;
+	limit = maxiters + 2;
     if (spat->spat_short) {
 	i = spat->spat_short->str_cur;
 	if (i == 1) {
@@ -353,6 +363,7 @@ int *arglast;
 	}
     }
     else {
+	maxiters += (strend - s) * spat->spat_regexp->nparens;
 	while (s < strend && --limit &&
 	    regexec(spat->spat_regexp, s, strend, orig, 1, Nullstr, TRUE) ) {
 	    if (spat->spat_regexp->subbase
@@ -389,7 +400,7 @@ int *arglast;
 	iters = sp + 1;
     else
 	iters = sp - arglast[0];
-    if (iters > 9999)
+    if (iters > maxiters)
 	fatal("Split loop");
     if (s < strend || origlimit) {	/* keep field after final delim? */
 	if (realarray)
@@ -468,19 +479,20 @@ int *arglast;
     unsigned long aulong;
     char *aptr;
 
-    if (gimme != G_ARRAY) {
-	str_sset(str,&str_undef);
-	STABSET(str);
-	st[sp] = str;
-	return sp;
+    if (gimme != G_ARRAY) {		/* arrange to do first one only */
+	patend = pat+1;
+	if (*pat == 'a' || *pat == 'A') {
+	    while (isdigit(*patend))
+		patend++;
+	}
     }
     sp--;
     while (pat < patend) {
 	datumtype = *pat++;
 	if (isdigit(*pat)) {
-	    len = atoi(pat);
+	    len = *pat++ - '0';
 	    while (isdigit(*pat))
-		pat++;
+		len = (len * 10) + (*pat++ - '0');
 	}
 	else
 	    len = 1;
@@ -675,8 +687,8 @@ int *arglast;
 	if (numarray) {
 	    while (sp < max) {
 		if (st[++sp]) {
-		    st[sp-1] = afetch(stab_array(stab),(int)str_gnum(st[sp]),
-			lval);
+		    st[sp-1] = afetch(stab_array(stab),
+		      ((int)str_gnum(st[sp])) - arybase, lval);
 		}
 		else
 		    st[sp-1] = &str_undef;
@@ -700,7 +712,8 @@ int *arglast;
     else {
 	if (numarray) {
 	    if (st[max])
-		st[sp] = afetch(stab_array(stab),(int)str_gnum(st[max]), lval);
+		st[sp] = afetch(stab_array(stab),
+		  ((int)str_gnum(st[max])) - arybase, lval);
 	    else
 		st[sp] = &str_undef;
 	}
@@ -732,6 +745,7 @@ int *arglast;
     register int sp = arglast[2];
     register int i = sp - arglast[1];
     int oldsave = savestack->ary_fill;
+    SPAT *oldspat = curspat;
 
     savesptr(&stab_val(defstab));
     if ((arg[1].arg_type & A_MASK) != A_EXPR) {
@@ -747,10 +761,11 @@ int *arglast;
 	if (str_true(st[sp+1]))
 	    st[dst++] = st[src];
 	src++;
+	curspat = oldspat;
     }
     restorelist(oldsave);
     if (gimme != G_ARRAY) {
-	str_sset(str,&str_undef);
+	str_numset(str,(double)(dst - arglast[1]));
 	STABSET(str);
 	st[arglast[0]+1] = str;
 	return arglast[0]+1;
diff --git a/eval.c b/eval.c
index 95870b1ab9..03518a8bb4 100644
--- a/eval.c
+++ b/eval.c
@@ -1,4 +1,4 @@
-/* $Header: eval.c,v 3.0.1.3 89/12/21 20:03:05 lwall Locked $
+/* $Header: eval.c,v 3.0.1.4 90/02/28 17:36:59 lwall Locked $
  *
  *    Copyright (c) 1989, Larry Wall
  *
@@ -6,6 +6,18 @@
  *    as specified in the README file that comes with the perl 3.0 kit.
  *
  * $Log:	eval.c,v $
+ * Revision 3.0.1.4  90/02/28  17:36:59  lwall
+ * patch9: added pipe function
+ * patch9: a return in scalar context wouldn't return array
+ * patch9: !~ now always returns scalar even in array context
+ * patch9: some machines can't cast float to long with high bit set
+ * patch9: piped opens returned undef in child
+ * patch9: @array in scalar context now returns length of array
+ * patch9: chdir; coredumped
+ * patch9: wait no longer ignores signals
+ * patch9: mkdir now handles odd versions of /bin/mkdir
+ * patch9: -l FILEHANDLE now disallowed
+ * 
  * Revision 3.0.1.3  89/12/21  20:03:05  lwall
  * patch7: errno may now be a macro with an lvalue
  * patch7: ANSI strerror() is now supported
@@ -48,6 +60,7 @@ static STAB *stab2;
 static STIO *stio;
 static struct lstring *lstr;
 static char old_record_separator;
+extern int wantarray;
 
 double sin(), cos(), atan2(), pow();
 
@@ -141,10 +154,12 @@ register int sp;
 	STR_SSET(str,st[1]);
 	anum = (int)str_gnum(st[2]);
 	if (anum >= 1) {
-	    tmpstr = Str_new(50,0);
+	    tmpstr = Str_new(50, 0);
 	    str_sset(tmpstr,str);
-	    while (--anum > 0)
-		str_scat(str,tmpstr);
+	    tmps = str_get(tmpstr);	/* force to be string */
+	    STR_GROW(str, (anum * str->str_cur) + 1);
+	    repeatcpy(str->str_ptr, tmps, tmpstr->str_cur, anum);
+	    str->str_cur *= anum; str->str_ptr[str->str_cur] = '\0';
 	}
 	else
 	    str_sset(str,&str_no);
@@ -159,9 +174,7 @@ register int sp;
 	break;
     case O_NMATCH:
 	sp = do_match(str,arg,
-	  gimme,arglast);
-	if (gimme == G_ARRAY)
-	    goto array_return;
+	  G_SCALAR,arglast);
 	str_sset(str, str_true(str) ? &str_no : &str_yes);
 	STABSET(str);
 	break;
@@ -270,14 +283,14 @@ register int sp;
 	value = str_gnum(st[1]);
 	anum = (int)str_gnum(st[2]);
 #ifndef lint
-	value = (double)(((long)value) << anum);
+	value = (double)(((unsigned long)value) << anum);
 #endif
 	goto donumset;
     case O_RIGHT_SHIFT:
 	value = str_gnum(st[1]);
 	anum = (int)str_gnum(st[2]);
 #ifndef lint
-	value = (double)(((long)value) >> anum);
+	value = (double)(((unsigned long)value) >> anum);
 #endif
 	goto donumset;
     case O_LT:
@@ -313,7 +326,8 @@ register int sp;
 	if (!sawvec || st[1]->str_nok || st[2]->str_nok) {
 	    value = str_gnum(st[1]);
 #ifndef lint
-	    value = (double)(((long)value) & (long)str_gnum(st[2]));
+	    value = (double)(((unsigned long)value) &
+			(unsigned long)str_gnum(st[2]));
 #endif
 	    goto donumset;
 	}
@@ -324,7 +338,8 @@ register int sp;
 	if (!sawvec || st[1]->str_nok || st[2]->str_nok) {
 	    value = str_gnum(st[1]);
 #ifndef lint
-	    value = (double)(((long)value) ^ (long)str_gnum(st[2]));
+	    value = (double)(((unsigned long)value) ^
+			(unsigned long)str_gnum(st[2]));
 #endif
 	    goto donumset;
 	}
@@ -335,7 +350,8 @@ register int sp;
 	if (!sawvec || st[1]->str_nok || st[2]->str_nok) {
 	    value = str_gnum(st[1]);
 #ifndef lint
-	    value = (double)(((long)value) | (long)str_gnum(st[2]));
+	    value = (double)(((unsigned long)value) |
+			(unsigned long)str_gnum(st[2]));
 #endif
 	    goto donumset;
 	}
@@ -414,7 +430,7 @@ register int sp;
 	goto donumset;
     case O_COMPLEMENT:
 #ifndef lint
-	value = (double) ~(long)str_gnum(st[1]);
+	value = (double) ~(unsigned long)str_gnum(st[1]);
 #endif
 	goto donumset;
     case O_SELECT:
@@ -502,11 +518,14 @@ register int sp;
 	    stab = arg[1].arg_ptr.arg_stab;
 	else
 	    stab = stabent(str_get(st[1]),TRUE);
-	if (do_open(stab,str_get(st[2]))) {
+	tmps = str_get(st[2]);
+	if (do_open(stab,tmps,st[2]->str_cur)) {
 	    value = (double)forkprocess;
 	    stab_io(stab)->lines = 0;
 	    goto donumset;
 	}
+	else if (forkprocess == 0)		/* we are a new child */
+	    goto say_zero;
 	else
 	    goto say_undef;
 	break;
@@ -556,9 +575,10 @@ register int sp;
 	    sp += maxarg;
 	    goto array_return;
 	}
-	else
-	    str = afetch(ary,maxarg - 1,FALSE);
-	break;
+	else {
+	    value = (double)maxarg;
+	    goto donumset;
+	}
     case O_AELEM:
 	anum = ((int)str_gnum(st[2])) - arybase;
 	str = afetch(stab_array(arg[1].arg_ptr.arg_stab),anum,FALSE);
@@ -824,7 +844,7 @@ register int sp;
 	goto donumset;
     case O_CHDIR:
 	if (maxarg < 1)
-	    tmps = str_get(stab_val(defstab));
+	    tmps = Nullch;
 	else
 	    tmps = str_get(st[1]);
 	if (!tmps || !*tmps) {
@@ -993,9 +1013,9 @@ register int sp;
 	STABSET(str);
 	break;
     case O_RETURN:
-	tmps = "SUB";		/* just fake up a "last SUB" */
+	tmps = "_SUB_";		/* just fake up a "last _SUB_" */
 	optype = O_LAST;
-	if (gimme == G_ARRAY) {
+	if (wantarray == G_ARRAY) {
 	    lastretstr = Nullstr;
 	    lastspbase = arglast[1];
 	    lastsize = arglast[2] - arglast[1];
@@ -1304,17 +1324,17 @@ register int sp;
 	goto donumset;
     case O_WAIT:
 #ifndef lint
-	ihand = signal(SIGINT, SIG_IGN);
-	qhand = signal(SIGQUIT, SIG_IGN);
+	/* ihand = signal(SIGINT, SIG_IGN); */
+	/* qhand = signal(SIGQUIT, SIG_IGN); */
 	anum = wait(&argflags);
 	if (anum > 0)
 	    pidgone(anum,argflags);
 	value = (double)anum;
 #else
-	ihand = qhand = 0;
+	/* ihand = qhand = 0; */
 #endif
-	(void)signal(SIGINT, ihand);
-	(void)signal(SIGQUIT, qhand);
+	/* (void)signal(SIGINT, ihand); */
+	/* (void)signal(SIGQUIT, qhand); */
 	statusvalue = (unsigned short)argflags;
 	goto donumset;
     case O_SYSTEM:
@@ -1491,6 +1511,8 @@ register int sp;
 		    errno = EEXIST;
 		else if (instr(buf,"non-exist"))
 		    errno = ENOENT;
+		else if (instr(buf,"does not exist"))
+		    errno = ENOENT;
 		else if (instr(buf,"not empty"))
 		    errno = EBUSY;
 		else if (instr(buf,"cannot access"))
@@ -1600,7 +1622,7 @@ register int sp;
 	    stab = arg[1].arg_ptr.arg_stab;
 	else
 	    stab = stabent(str_get(st[1]),TRUE);
-	argtype = (int)str_gnum(st[2]);
+	argtype = (unsigned int)str_gnum(st[2]);
 #ifdef TAINT
 	taintproper("Insecure dependency in ioctl");
 #endif
@@ -1748,6 +1770,8 @@ register int sp;
 	goto say_no;
 #endif
     case O_FTLINK:
+	if (arg[1].arg_type & A_DONT)
+	    fatal("You must supply explicit filename with -l");
 #ifdef LSTAT
 	if (lstat(str_get(st[1]),&statcache) < 0)
 	    goto say_undef;
@@ -2070,6 +2094,18 @@ register int sp;
     case O_SYSCALL:
 	value = (double)do_syscall(arglast);
 	goto donumset;
+    case O_PIPE:
+	if ((arg[1].arg_type & A_MASK) == A_WORD)
+	    stab = arg[1].arg_ptr.arg_stab;
+	else
+	    stab = stabent(str_get(st[1]),TRUE);
+	if ((arg[2].arg_type & A_MASK) == A_WORD)
+	    stab2 = arg[2].arg_ptr.arg_stab;
+	else
+	    stab2 = stabent(str_get(st[2]),TRUE);
+	do_pipe(str,stab,stab2);
+	STABSET(str);
+	break;
     }
 
   normal_return:
@@ -2087,8 +2123,21 @@ array_return:
 #ifdef DEBUGGING
     if (debug) {
 	dlevel--;
-	if (debug & 8)
-	    deb("%s RETURNS ARRAY OF %d ARGS\n",opname[optype],sp - arglast[0]);
+	if (debug & 8) {
+	    anum = sp - arglast[0];
+	    switch (anum) {
+	    case 0:
+		deb("%s RETURNS ()\n",opname[optype]);
+		break;
+	    case 1:
+		deb("%s RETURNS (\"%s\")\n",opname[optype],str_get(st[1]));
+		break;
+	    default:
+		deb("%s RETURNS %d ARGS (\"%s\",%s\"%s\"\n",opname[optype],anum,
+		  str_get(st[1]),anum==2?"":"...,",str_get(st[anum]));
+		break;
+	    }
+	}
     }
 #endif
     return sp;
diff --git a/lib/complete.pl b/lib/complete.pl
index 334d5390c6..b59bee32ee 100644
--- a/lib/complete.pl
+++ b/lib/complete.pl
@@ -25,6 +25,7 @@ sub Complete {
     local ($prompt) = shift (@_);
     local ($c, $cmp, $l, $r, $ret, $return, $test);
     @_cmp_lst = sort @_;
+    local($[) = 0;
     system 'stty raw -echo';
     loop: {
 	print $prompt, $return;
diff --git a/patchlevel.h b/patchlevel.h
index 618bca4808..4e0e918bcb 100644
--- a/patchlevel.h
+++ b/patchlevel.h
@@ -1 +1 @@
-#define PATCHLEVEL 9
+#define PATCHLEVEL 10
diff --git a/t/base.term b/t/base.term
index 945dedda5c..6055fe218c 100644
--- a/t/base.term
+++ b/t/base.term
@@ -1,6 +1,6 @@
 #!./perl
 
-# $Header: base.term,v 3.0 89/10/18 15:24:34 lwall Locked $
+# $Header: base.term,v 3.0.1.1 90/02/28 18:31:56 lwall Locked $
 
 print "1..6\n";
 
@@ -30,7 +30,13 @@ if ($x == '1') {print "ok 4\n";} else {print "not ok 4\n";}
 # check <> pseudoliteral
 
 open(try, "/dev/null") || (die "Can't open /dev/null.");
-if (<try> eq '') {print "ok 5\n";} else {print "not ok 5\n";}
+if (<try> eq '') {
+    print "ok 5\n";
+}
+else {
+    print "not ok 5\n";
+    die "/dev/null IS NOT A CHARACTER SPECIAL FILE!!!!\n" unless -c '/dev/null';
+}
 
 open(try, "../Makefile") || (die "Can't open ../Makefile.");
 if (<try> ne '') {print "ok 6\n";} else {print "not ok 6\n";}