perl 3.0 patch #11 patch #9, continued

See patch #9.

20 files changed, 290 insertions, 122 deletions

diff --git a/eg/g/gsh b/eg/g/gsh
index b60deb20b7..5ac8a4b4aa 100644
--- a/eg/g/gsh
+++ b/eg/g/gsh
@@ -1,6 +1,6 @@
-#!/bin/perl
+#! /usr/bin/perl
 
-# $Header: gsh,v 3.0 89/10/18 15:14:36 lwall Locked $
+# $Header: gsh,v 3.0.1.1 90/02/28 17:14:10 lwall Locked $
 
 # Do rsh globally--see man page
 
@@ -8,11 +8,12 @@ $SIG{'QUIT'} = 'quit';			# install signal handler for SIGQUIT
 
 sub getswitches {
     while ($ARGV[0] =~ /^-/) {		# parse switches
-	$ARGV[0] =~ /^-h/ && ($showhost++,$silent++,shift,next);
-	$ARGV[0] =~ /^-s/ && ($silent++,shift,next);
-	$ARGV[0] =~ /^-d/ && ($dodist++,shift,next);
-	$ARGV[0] =~ /^-n/ && ($n=' -n',shift,next);
-	$ARGV[0] =~ /^-l/ && ($l=' -l ' . $ARGV[1],shift,shift,next);
+	$ARGV[0] =~ /^-h/ && ($showhost++,$silent++,shift(@ARGV),next);
+	$ARGV[0] =~ /^-s/ && ($silent++,shift(@ARGV),next);
+	$ARGV[0] =~ /^-d/ && ($dodist++,shift(@ARGV),next);
+	$ARGV[0] =~ /^-n/ && ($n=' -n',shift(@ARGV),next);
+	$ARGV[0] =~ /^-l/ && ($l=' -l ' . $ARGV[1],shift(@ARGV),shift(@ARGV),
+				next);
 	last;
     }
 }
diff --git a/evalargs.xc b/evalargs.xc
index b2fd32560b..76ac19a74e 100644
--- a/evalargs.xc
+++ b/evalargs.xc
@@ -2,9 +2,12 @@
  * kit sizes from getting too big.
  */
 
-/* $Header: evalargs.xc,v 3.0.1.3 89/11/17 15:25:07 lwall Locked $
+/* $Header: evalargs.xc,v 3.0.1.4 90/02/28 17:38:37 lwall Locked $
  *
  * $Log:	evalargs.xc,v $
+ * Revision 3.0.1.4  90/02/28  17:38:37  lwall
+ * patch9: $#foo -= 2 didn't work
+ * 
  * Revision 3.0.1.3  89/11/17  15:25:07  lwall
  * patch5: constant numeric subscripts disappeared in ?:
  * 
@@ -176,7 +179,7 @@
 	    ++sp;
 	    stab = argptr.arg_stab;
 	    str = stab_array(argptr.arg_stab)->ary_magic;
-	    if (argflags & (AF_PRE|AF_POST))
+	    if (optype != O_SASSIGN || argflags & (AF_PRE|AF_POST))
 		str_numset(str,(double)(stab_array(stab)->ary_fill+arybase));
 #ifdef DEBUGGING
 	    tmps = "LARYLEN";
@@ -229,8 +232,6 @@
 	    break;
 	case A_WANTARRAY:
 	    {
-		extern int wantarray;
-
 		if (wantarray == G_ARRAY)
 		    st[++sp] = &str_yes;
 		else
@@ -295,7 +296,8 @@
 			str_cat(tmpstr,
 			  "|tr -s ' \t\f\r' '\\012\\012\\012\\012'|");
 #endif
-			(void)do_open(last_in_stab,tmpstr->str_ptr);
+			(void)do_open(last_in_stab,tmpstr->str_ptr,
+			  tmpstr->str_cur);
 			fp = stab_io(last_in_stab)->ifp;
 			str_free(tmpstr);
 		    }
diff --git a/form.c b/form.c
index 5d0db88287..ba82433b41 100644
--- a/form.c
+++ b/form.c
@@ -1,4 +1,4 @@
-/* $Header: form.c,v 3.0 89/10/18 15:17:26 lwall Locked $
+/* $Header: form.c,v 3.0.1.1 90/02/28 17:39:34 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:	form.c,v $
+ * Revision 3.0.1.1  90/02/28  17:39:34  lwall
+ * patch9: ... in format threw off subsequent field
+ * 
  * Revision 3.0  89/10/18  15:17:26  lwall
  * 3.0 baseline
  * 
@@ -157,6 +160,7 @@ int sp;
 		    *d++ = '.';
 		    *d++ = '.';
 		    *d++ = '.';
+		    size -= 3;
 		}
 		while (*chophere && index(chopset,*chophere))
 		    chophere++;
diff --git a/lib/getopt.pl b/lib/getopt.pl
index b85b643e22..93acafc5bf 100644
--- a/lib/getopt.pl
+++ b/lib/getopt.pl
@@ -1,4 +1,4 @@
-;# $Header: getopt.pl,v 3.0 89/10/18 15:19:26 lwall Locked $
+;# $Header: getopt.pl,v 3.0.1.1 90/02/28 17:41:59 lwall Locked $
 
 ;# Process single-character switches with switch clustering.  Pass one argument
 ;# which is a string containing all switches that take an argument.  For each
@@ -12,6 +12,7 @@
 sub Getopt {
     local($argumentative) = @_;
     local($_,$first,$rest);
+    local($[) = 0;
 
     while (($_ = $ARGV[0]) =~ /^-(.)(.*)/) {
 	($first,$rest) = ($1,$2);
diff --git a/lib/getopts.pl b/lib/getopts.pl
index 7effafa195..4ed3a053f9 100644
--- a/lib/getopts.pl
+++ b/lib/getopts.pl
@@ -6,7 +6,8 @@
 
 sub Getopts {
     local($argumentative) = @_;
-    local(@args,$_,$first,$rest);
+    local(@args,$_,$first,$rest,$errs);
+    local($[) = 0;
 
     @args = split( / */, $argumentative );
     while(($_ = $ARGV[0]) =~ /^-(.)(.*)/) {
@@ -31,7 +32,8 @@ sub Getopts {
 	    }
 	}
 	else {
-	    print stderr "Unknown option: $first\n";
+	    print STDERR "Unknown option: $first\n";
+	    ++$errs;
 	    if($rest ne '') {
 		$ARGV[0] = "-$rest";
 	    }
@@ -40,6 +42,7 @@ sub Getopts {
 	    }
 	}
     }
+    $errs == 0;
 }
 
 1;
diff --git a/lib/look.pl b/lib/look.pl
index ebbaa73a3d..6eef43983b 100644
--- a/lib/look.pl
+++ b/lib/look.pl
@@ -11,13 +11,11 @@ sub look {
     $blksize = 8192 unless $blksize;
     $key =~ s/[^\w\s]//g if $dict;
     $key =~ y/A-Z/a-z/ if $fold;
-    $max = $size + $blksize - 1;
-    $max -= $size % $blksize;
-    while ($max - $min > $blksize) {
-	$mid = ($max + $min) / 2;
-	die "look: internal error"  if $mid % $blksize;
-	seek(FH,$mid,0);
-	$_ = <FH>;		# probably a partial line
+    $max = int($size / $blksize);
+    while ($max - $min > 1) {
+	$mid = int(($max + $min) / 2);
+	seek(FH,$mid * $blksize,0);
+	$_ = <FH> if $mid;		# probably a partial line
 	$_ = <FH>;
 	chop;
 	s/[^\w\s]//g if $dict;
@@ -29,7 +27,9 @@ sub look {
 	    $max = $mid;
 	}
     }
+    $min *= $blksize;
     seek(FH,$min,0);
+    <FH> if $min;
     while (<FH>) {
 	chop;
 	s/[^\w\s]//g if $dict;
diff --git a/patchlevel.h b/patchlevel.h
index 4e0e918bcb..98702f8e84 100644
--- a/patchlevel.h
+++ b/patchlevel.h
@@ -1 +1 @@
-#define PATCHLEVEL 10
+#define PATCHLEVEL 11
diff --git a/perl.h b/perl.h
index 038d41ad94..ff95c2680b 100644
--- a/perl.h
+++ b/perl.h
@@ -1,4 +1,4 @@
-/* $Header: perl.h,v 3.0.1.4 89/12/21 20:07:35 lwall Locked $
+/* $Header: perl.h,v 3.0.1.5 90/02/28 17:52:28 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:	perl.h,v $
+ * Revision 3.0.1.5  90/02/28  17:52:28  lwall
+ * patch9: Configure now determines whether volatile is supported
+ * patch9: volatilized some more variables for super-optimizing compilers
+ * patch9: unused VREG symbol deleted
+ * patch9: perl can now start up other interpreters scripts  
+ * patch9: you may now undef $/ to have no input record separator
+ * patch9: nested evals clobbered their longjmp environment
+ * 
  * Revision 3.0.1.4  89/12/21  20:07:35  lwall
  * patch7: arranged for certain registers to be restored after longjmp()
  * patch7: Configure now compiles a test program to figure out time.h fiasco
@@ -35,17 +43,15 @@
  * 
  */
 
-#ifdef __STDC__
+#define VOIDUSED 1
+#include "config.h"
+
+#if defined(HASVOLATILE) || defined(__STDC__)
 #define VOLATILE volatile
-#define VREG
 #else
 #define VOLATILE
-#define VREG register
 #endif
 
-#define VOIDUSED 1
-#include "config.h"
-
 #ifdef IAMSUID
 #   ifndef TAINT
 #	define TAINT
@@ -420,6 +426,7 @@ void stab_clear();
 void do_join();
 void do_sprintf();
 void do_accept();
+void do_pipe();
 void do_vecset();
 void savelist();
 void saveitem();
@@ -428,9 +435,12 @@ void savelong();
 void savesptr();
 void savehptr();
 void restorelist();
+void repeatcpy();
 HASH *savehash();
 ARRAY *saveary();
 
+EXT char **origargv;
+EXT int origargc;
 EXT line_t line INIT(0);
 EXT line_t subline INIT(0);
 EXT STR *subname INIT(Nullstr);
@@ -476,7 +486,7 @@ EXT int lastsize;
 
 EXT char *filename;
 EXT char *origfilename;
-EXT FILE *rsfp;
+EXT FILE * VOLATILE rsfp;
 EXT char buf[1024];
 EXT char *bufptr;
 EXT char *oldbufptr;
@@ -485,7 +495,7 @@ EXT char *bufend;
 
 EXT STR *linestr INIT(Nullstr);
 
-EXT char record_separator INIT('\n');
+EXT int record_separator INIT('\n');
 EXT int rslen INIT(1);
 EXT char *ofs INIT(Nullch);
 EXT int ofslen INIT(0);
@@ -506,6 +516,7 @@ EXT bool sawampersand INIT(FALSE);	/* must save all match strings */
 EXT bool sawstudy INIT(FALSE);		/* do fbminstr on all strings */
 EXT bool sawi INIT(FALSE);		/* study must assume case insensitive */
 EXT bool sawvec INIT(FALSE);
+EXT bool localizing INIT(FALSE);	/* are we processing a local() list? */
 
 #ifdef CSH
 char *cshname INIT(CSH);
@@ -522,7 +533,7 @@ EXT FILE *e_fp INIT(Nullfp);
 
 EXT char tokenbuf[256];
 EXT int expectterm INIT(TRUE);		/* how to interpret ambiguous tokens */
-EXT int in_eval INIT(FALSE);		/* trap fatal errors? */
+EXT VOLATILE int in_eval INIT(FALSE);	/* trap fatal errors? */
 EXT int multiline INIT(0);		/* $*--do strings hold >1 line? */
 EXT int forkprocess;			/* so do_open |- can return proc# */
 EXT int do_undump INIT(0);		/* -u or dump seen? */
@@ -554,7 +565,7 @@ GIDTYPE getegid();
 EXT int unsafe;
 
 #ifdef DEBUGGING
-EXT int debug INIT(0);
+EXT VOLATILE int debug INIT(0);
 EXT int dlevel INIT(0);
 EXT int dlmax INIT(128);
 EXT char *debname;
@@ -581,13 +592,12 @@ EXT int loop_ptr INIT(-1);
 EXT int loop_max INIT(128);
 
 EXT jmp_buf top_env;
-EXT jmp_buf eval_env;
 
-EXT char *goto_targ INIT(Nullch);	/* cmd_exec gets strange when set */
+EXT char * VOLATILE goto_targ INIT(Nullch); /* cmd_exec gets strange when set */
 
 EXT ARRAY *stack;		/* THE STACK */
 
-EXT ARRAY *savestack;		/* to save non-local values on */
+EXT ARRAY * VOLATILE savestack;		/* to save non-local values on */
 
 EXT ARRAY *tosave;		/* strings to save on recursive subroutine */
 
@@ -595,6 +605,10 @@ EXT ARRAY *lineary;		/* lines of script for debugger */
 
 EXT ARRAY *pidstatary;		/* keep pids and statuses by fd for mypopen */
 
+EXT int *di;			/* for tmp use in debuggers */
+EXT char *dc;
+EXT short *ds;
+
 double atof();
 long time();
 struct tm *gmtime(), *localtime();
diff --git a/perl.man.1 b/perl.man.1
index 33a48a3cfd..ec50d5f062 100644
--- a/perl.man.1
+++ b/perl.man.1
@@ -1,7 +1,11 @@
 .rn '' }`
-''' $Header: perl.man.1,v 3.0.1.2 89/11/17 15:30:03 lwall Locked $
+''' $Header: perl.man.1,v 3.0.1.3 90/02/28 17:54:32 lwall Locked $
 ''' 
 ''' $Log:	perl.man.1,v $
+''' Revision 3.0.1.3  90/02/28  17:54:32  lwall
+''' patch9: @array in scalar context now returns length of array
+''' patch9: in manual, example of open and ?: was backwards
+''' 
 ''' Revision 3.0.1.2  89/11/17  15:30:03  lwall
 ''' patch5: fixed some manual typos and indent problems
 ''' 
@@ -481,9 +485,20 @@ The following are exactly equivalent
 
 .fi
 .PP
+If you evaluate an array in a scalar context, it returns the length of
+the array.
+The following is always true:
+.nf
+
+	@whatever == $#whatever \- $[ + 1;
+
+.fi
+.PP
 Multi-dimensional arrays are not directly supported, but see the discussion
 of the $; variable later for a means of emulating multiple subscripts with
 an associative array.
+You could also write a subroutine to turn multiple subscripts into a single
+subscript.
 .PP
 Every data type has its own namespace.
 You can, without fear of conflict, use the same name for a scalar variable,
@@ -684,7 +699,7 @@ Evaluating a filehandle in angle brackets yields the next line
 from that file (newline included, so it's never false until EOF, at
 which time an undefined value is returned).
 Ordinarily you must assign that value to a variable,
-but there is one situation where in which an automatic assignment happens.
+but there is one situation where an automatic assignment happens.
 If (and only if) the input symbol is the only thing inside the conditional of a
 .I while
 loop, the value is
@@ -896,7 +911,7 @@ The following all do the same thing:
 	if (!open(foo)) { die "Can't open $foo: $!"; }
 	die "Can't open $foo: $!" unless open(foo);
 	open(foo) || die "Can't open $foo: $!";	# foo or bust!
-	open(foo) ? die "Can't open $foo: $!" : \'hi mom\';
+	open(foo) ? \'hi mom\' : die "Can't open $foo: $!";
 				# a bit exotic, that last one
 
 .fi
diff --git a/perl.man.2 b/perl.man.2
index ddd53655ff..7fc67f80a0 100644
--- a/perl.man.2
+++ b/perl.man.2
@@ -1,7 +1,11 @@
 ''' Beginning of part 2
-''' $Header: perl.man.2,v 3.0.1.2 89/11/17 15:30:16 lwall Locked $
+''' $Header: perl.man.2,v 3.0.1.3 90/02/28 17:55:58 lwall Locked $
 '''
 ''' $Log:	perl.man.2,v $
+''' Revision 3.0.1.3  90/02/28  17:55:58  lwall
+''' patch9: grep now returns number of items matched in scalar context
+''' patch9: documented in-place modification capabilites of grep
+''' 
 ''' Revision 3.0.1.2  89/11/17  15:30:16  lwall
 ''' patch5: fixed some manual typos and indent problems
 ''' 
@@ -777,11 +781,16 @@ Better yet, don't use it at all.
 Evaluates EXPR for each element of LIST (locally setting $_ to each element)
 and returns the array value consisting of those elements for which the
 expression evaluated to true.
+In a scalar context, returns the number of times the expression was true.
 .nf
 
 	@foo = grep(!/^#/, @bar);    # weed out comments
 
 .fi
+Note that, since $_ is a reference into the array value, it can be
+used to modify the elements of the array.
+While this is useful and supported, it can cause bizarre results if
+the LIST contains literal values.
 .Ip "hex(EXPR)" 8 4
 .Ip "hex EXPR" 8
 Returns the decimal value of EXPR interpreted as an hex string.
diff --git a/perl.man.3 b/perl.man.3
index bd64915a99..7d3972c8d7 100644
--- a/perl.man.3
+++ b/perl.man.3
@@ -1,7 +1,13 @@
 ''' Beginning of part 3
-''' $Header: perl.man.3,v 3.0.1.3 89/12/21 20:10:12 lwall Locked $
+''' $Header: perl.man.3,v 3.0.1.4 90/02/28 18:00:09 lwall Locked $
 '''
 ''' $Log:	perl.man.3,v $
+''' Revision 3.0.1.4  90/02/28  18:00:09  lwall
+''' patch9: added pipe function
+''' patch9: documented how to handle arbitrary weird characters in filenames
+''' patch9: documented the unflushed buffers problem on piped opens
+''' patch9: documented how to force top of page
+''' 
 ''' Revision 3.0.1.3  89/12/21  20:10:12  lwall
 ''' patch7: documented that s`pat`repl` does command substitution on replacement
 ''' patch7: documented that $timeleft from select() is likely not implemented
@@ -202,6 +208,22 @@ The following pairs are equivalent:
 .fi
 Explicitly closing any piped filehandle causes the parent process to wait for the
 child to finish, and returns the status value in $?.
+Note: on any operation which may do a fork,
+unflushed buffers remain unflushed in both
+processes, which means you may need to set $| to
+avoid duplicate output.
+.Sp
+The filename that is passed to open will have leading and trailing
+whitespace deleted.
+In order to open a file with arbitrary weird characters in it, it's necessary
+to protect any leading and trailing whitespace thusly:
+.nf
+
+.ne 2
+        $file =~ s#^(\es)#./$1#;
+        open(FOO, "< $file\e0");
+
+.fi
 .Ip "opendir(DIRHANDLE,EXPR)" 8 3
 Opens a directory named EXPR for processing by readdir(), telldir(), seekdir(),
 rewinddir() and closedir().
@@ -270,6 +292,14 @@ Examples:
 
 .fi
 The same template may generally also be used in the unpack function.
+.Ip "pipe(READHANDLE,WRITEHANDLE)" 8 3
+Opens a pair of connected pipes like the corresponding system call.
+Note that if you set up a loop of piped processes, deadlock can occur
+unless you are very careful.
+In addition, note that perl's pipes use stdio buffering, so you may need
+to set $| to flush your WRITEHANDLE after each command, depending on
+the application.
+[Requires version 3.0 patchlevel 9.]
 .Ip "pop(ARRAY)" 8
 .Ip "pop ARRAY" 8 6
 Pops and returns the last value of the array, shortening the array by 1.
@@ -693,7 +723,9 @@ Examples:
 .Ip "split" 8
 Splits a string into an array of strings, and returns it.
 (If not in an array context, returns the number of fields found and splits
-into the @_ array.)
+into the @_ array.
+(In an array context, you can force the split into @_
+by using ?? as the pattern delimiters, but it still returns the array value.))
 If EXPR is omitted, splits the $_ string.
 If PATTERN is also omitted, splits on whitespace (/[\ \et\en]+/).
 Anything matching PATTERN is taken to be a delimiter separating the fields.
@@ -1119,11 +1151,14 @@ by assigning the name of the format to the $~ variable.
 .Sp
 Top of form processing is handled automatically:
 if there is insufficient room on the current page for the formatted 
-record, the page is advanced, a special top-of-page format is used
+record, the page is advanced by writing a form feed,
+a special top-of-page format is used
 to format the new page header, and then the record is written.
 By default the top-of-page format is \*(L"top\*(R", but it
 may be set to the
 format of your choice by assigning the name to the $^ variable.
+The number of lines remaining on the current page is in variable $-, which
+can be set to 0 to force a new page.
 .Sp
 If FILEHANDLE is unspecified, output goes to the current default output channel,
 which starts out as
diff --git a/perl.man.4 b/perl.man.4
index a3ab60c3b5..2843c20215 100644
--- a/perl.man.4
+++ b/perl.man.4
@@ -1,7 +1,10 @@
 ''' Beginning of part 4
-''' $Header: perl.man.4,v 3.0.1.4 89/12/21 20:12:39 lwall Locked $
+''' $Header: perl.man.4,v 3.0.1.5 90/02/28 18:01:52 lwall Locked $
 '''
 ''' $Log:	perl.man.4,v $
+''' Revision 3.0.1.5  90/02/28  18:01:52  lwall
+''' patch9: $0 is now always the command name
+''' 
 ''' Revision 3.0.1.4  89/12/21  20:12:39  lwall
 ''' patch7: documented that package'filehandle works as well as $package'variable
 ''' patch7: documented which identifiers are always in package main
@@ -263,7 +266,7 @@ The \e<digit> notation sometimes works outside the current pattern, but should
 not be relied upon.)
 $+ returns whatever the last bracket match matched.
 $& returns the entire matched string.
-($0 normally returns the same thing, but don't depend on it.)
+($0 used to return the same thing, but not any more.)
 $\` returns everything before the matched string.
 $\' returns everything after the matched string.
 Examples:
@@ -746,8 +749,6 @@ Default is 0.
 Contains the name of the file containing the
 .I perl
 script being executed.
-The value should be copied elsewhere before any pattern matching happens, which
-clobbers $0.
 (Mnemonic: same as sh and ksh.)
 .Ip $<digit> 8
 Contains the subpattern from the corresponding set of parentheses in the last
@@ -1168,10 +1169,10 @@ initialization code.
 For instance, you could make aliases like these:
 .nf
 
-    $DBalias{'len'} = 's/^len(.*)/p length(\e$1)/';
-    $DBalias{'stop'} = 's/^stop (at|in)/b/';
-    $DBalias{'.'} =
-      's/^./p "\e$DBsub(\e$DBline):\et\e$DBline[\e$DBline]"/';
+    $DB'alias{'len'} = 's/^len(.*)/p length($1)/';
+    $DB'alias{'stop'} = 's/^stop (at|in)/b/';
+    $DB'alias{'.'} =
+      's/^\e./p "\e$DB\e'sub(\e$DB\e'line):\et",\e$DB\e'line[\e$DB\e'line]/';
 
 .fi
 .Sh "Setuid Scripts"
@@ -1360,8 +1361,7 @@ operator has different arguments.
 .Ip * 4 2
 The current input line is normally in $_, not $0.
 It generally does not have the newline stripped.
-($0 is initially the name of the program executed, then the last matched
-string.)
+($0 is the name of the program executed.)
 .Ip * 4 2
 $<digit> does not refer to fields\*(--it refers to substrings matched by the last
 match pattern.
@@ -1409,7 +1409,7 @@ The following variables work differently
 	  OFS	\h'|2.5i'$,
 	  ORS	\h'|2.5i'$\e
 	  RLENGTH	\h'|2.5i'length($&)
-	  RS	\h'|2.5i'$\/
+	  RS	\h'|2.5i'$/
 	  RSTART	\h'|2.5i'length($\`)
 	  SUBSEP	\h'|2.5i'$;
 
diff --git a/perl.y b/perl.y
index 57e1bfc9bc..4e79d0619f 100644
--- a/perl.y
+++ b/perl.y
@@ -1,4 +1,4 @@
-/* $Header: perl.y,v 3.0.1.3 89/12/21 20:13:41 lwall Locked $
+/* $Header: perl.y,v 3.0.1.4 90/02/28 18:03:23 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:	perl.y,v $
+ * Revision 3.0.1.4  90/02/28  18:03:23  lwall
+ * patch9: line numbers were bogus during certain portions of foreach evaluation
+ * 
  * Revision 3.0.1.3  89/12/21  20:13:41  lwall
  * patch7: send() didn't allow a TO argument
  * 
@@ -229,6 +232,8 @@ loop	:	label WHILE '(' texpr ')' compblock
 					  stab2arg(A_STAB,scrstab),
 					  Nullarg,Nullarg ),
 					$7)))));
+				$$->c_line = $2;
+				$$->c_head->c_line = $2;
 			    }
 			    else {
 				$$ = wopt(over($3,add_label($1,
@@ -254,6 +259,8 @@ loop	:	label WHILE '(' texpr ')' compblock
 					  stab2arg(A_STAB,scrstab),
 					  Nullarg,Nullarg ),
 					$6)))));
+				$$->c_line = $2;
+				$$->c_head->c_line = $2;
 			    }
 			    else {	/* lisp, anyone? */
 				$$ = wopt(over(defstab,add_label($1,
diff --git a/perly.c b/perly.c
index 1471ff65f7..d0aec550e6 100644
--- a/perly.c
+++ b/perly.c
@@ -1,4 +1,4 @@
-char rcsid[] = "$Header: perly.c,v 3.0.1.3 89/12/21 20:15:41 lwall Locked $\nPatch level: ###\n";
+char rcsid[] = "$Header: perly.c,v 3.0.1.4 90/02/28 18:06:41 lwall Locked $\nPatch level: ###\n";
 /*
  *    Copyright (c) 1989, Larry Wall
  *
@@ -6,6 +6,11 @@ char rcsid[] = "$Header: perly.c,v 3.0.1.3 89/12/21 20:15:41 lwall Locked $\nPat
  *    as specified in the README file that comes with the perl 3.0 kit.
  *
  * $Log:	perly.c,v $
+ * Revision 3.0.1.4  90/02/28  18:06:41  lwall
+ * patch9: perl can now start up other interpreters scripts
+ * patch9: nested evals clobbered their longjmp environment
+ * patch9: eval could mistakenly return undef in array context
+ * 
  * Revision 3.0.1.3  89/12/21  20:15:41  lwall
  * patch7: ANSI strerror() is now supported
  * patch7: errno may now be a macro with an lvalue
@@ -48,7 +53,6 @@ register char **env;
     register char *s;
     char *index(), *strcpy(), *getenv();
     bool dosearch = FALSE;
-    char **origargv = argv;
 #ifdef DOSUID
     char *validarg = "";
 #endif
@@ -61,13 +65,15 @@ setuid perl scripts securely.\n");
 #endif
 #endif
 
+    origargv = argv;
+    origargc = argc;
     uid = (int)getuid();
     euid = (int)geteuid();
     gid = (int)getgid();
     egid = (int)getegid();
     if (do_undump) {
 	do_undump = 0;
-	loop_ptr = 0;		/* start label stack again */
+	loop_ptr = -1;		/* start label stack again */
 	goto just_doit;
     }
     (void)sprintf(index(rcsid,'#'), "%d\n", PATCHLEVEL);
@@ -670,7 +676,7 @@ FIX YOUR KERNEL, PUT A C WRAPPER AROUND THIS SCRIPT, OR USE -u AND UNDUMP!\n");
 	str_numset(STAB_STR(tmpstab),(double)getpid());
 
     if (setjmp(top_env))	/* sets goto_targ on longjump */
-	loop_ptr = 0;		/* start label stack again */
+	loop_ptr = -1;		/* start label stack again */
 
 #ifdef DEBUGGING
     if (debug & 1024)
@@ -719,14 +725,15 @@ int *arglast;
     CMD *myroot;
     ARRAY *ar;
     int i;
-    char *oldfile = filename;
-    line_t oldline = line;
-    int oldtmps_base = tmps_base;
-    int oldsave = savestack->ary_fill;
-    SPAT *oldspat = curspat;
+    char * VOLATILE oldfile = filename;
+    VOLATILE line_t oldline = line;
+    VOLATILE int oldtmps_base = tmps_base;
+    VOLATILE int oldsave = savestack->ary_fill;
+    SPAT * VOLATILE oldspat = curspat;
     static char *last_eval = Nullch;
     static CMD *last_root = Nullcmd;
     VOLATILE int sp = arglast[0];
+    char *tmps;
 
     tmps_base = tmps_max;
     if (curstash != stash) {
@@ -772,7 +779,18 @@ int *arglast;
     in_eval++;
     oldoldbufptr = oldbufptr = bufptr = str_get(linestr);
     bufend = bufptr + linestr->str_cur;
-    if (setjmp(eval_env)) {
+    if (++loop_ptr >= loop_max) {
+	loop_max += 128;
+	Renew(loop_stack, loop_max, struct loop);
+    }
+    loop_stack[loop_ptr].loop_label = "_EVAL_";
+    loop_stack[loop_ptr].loop_sp = sp;
+#ifdef DEBUGGING
+    if (debug & 4) {
+	deb("(Pushing label #%d _EVAL_)\n", loop_ptr);
+    }
+#endif
+    if (setjmp(loop_stack[loop_ptr].loop_env)) {
 	retval = 1;
 	last_root = Nullcmd;
     }
@@ -800,7 +818,10 @@ int *arglast;
     }
     myroot = eval_root;		/* in case cmd_exec does another eval! */
     if (retval || error_count) {
-	str = &str_undef;
+	st = stack->ary_array;
+	sp = arglast[0];
+	if (gimme != G_ARRAY)
+	    st[++sp] = &str_undef;
 	last_root = Nullcmd;	/* can't free on error, for some reason */
 	if (rsfp) {
 	    fclose(rsfp);
@@ -817,6 +838,14 @@ int *arglast;
 	    cmd_free(myroot);
     }
     in_eval--;
+#ifdef DEBUGGING
+	if (debug & 4) {
+	    tmps = loop_stack[loop_ptr].loop_label;
+	    deb("(Popping label #%d %s)\n",loop_ptr,
+		tmps ? tmps : "" );
+	}
+#endif
+    loop_ptr--;
     filename = oldfile;
     line = oldline;
     tmps_base = oldtmps_base;
diff --git a/regcomp.c b/regcomp.c
index cde84bd77b..1333de2f7b 100644
--- a/regcomp.c
+++ b/regcomp.c
@@ -7,9 +7,12 @@
  * blame Henry for some of the lack of readability.
  */
 
-/* $Header: regcomp.c,v 3.0.1.1 89/11/11 04:51:04 lwall Locked $
+/* $Header: regcomp.c,v 3.0.1.2 90/02/28 18:08:35 lwall Locked $
  *
  * $Log:	regcomp.c,v $
+ * Revision 3.0.1.2  90/02/28  18:08:35  lwall
+ * patch9: /[\200-\377]/ didn't work on machines with signed chars
+ * 
  * Revision 3.0.1.1  89/11/11  04:51:04  lwall
  * patch2: /[\000]/ didn't work
  * 
@@ -770,6 +773,7 @@ register int c;
 {
 	if (regcode == &regdummy)
 	    return;
+	c &= 255;
 	if (def)
 		bits[c >> 3] &= ~(1 << (c & 7));
 	else
diff --git a/regexec.c b/regexec.c
index 0ccc8305ed..2c6213b782 100644
--- a/regexec.c
+++ b/regexec.c
@@ -7,9 +7,14 @@
  * blame Henry for some of the lack of readability.
  */
 
-/* $Header: regexec.c,v 3.0.1.2 89/12/21 20:16:27 lwall Locked $
+/* $Header: regexec.c,v 3.0.1.3 90/02/28 18:14:39 lwall Locked $
  *
  * $Log:	regexec.c,v $
+ * Revision 3.0.1.3  90/02/28  18:14:39  lwall
+ * patch9: /[\200-\377]/ didn't work on machines with signed chars
+ * patch9: \d, \w, and \s could misfire on characters with high bit set
+ * patch9: /\bfoo/i didn't work
+ * 
  * Revision 3.0.1.2  89/12/21  20:16:27  lwall
  * patch7: certain patterns didn't match correctly at end of string
  * 
@@ -64,6 +69,11 @@
 int regnarrate = 0;
 #endif
 
+#define isALNUM(c) (isascii(c) && (isalpha(c) || isdigit(c) || c == '_'))
+#define isSPACE(c) (isascii(c) && isspace(c))
+#define isDIGIT(c) (isascii(c) && isdigit(c))
+#define isUPPER(c) (isascii(c) && isupper(c))
+
 /*
  * regexec and friends
  */
@@ -73,6 +83,7 @@ int regnarrate = 0;
  */
 static char *regprecomp;
 static char *reginput;		/* String-input pointer. */
+static char regprev;		/* char before regbol, \n if none */
 static char *regbol;		/* Beginning of input, for ^ check. */
 static char *regeol;		/* End of input, for $ check. */
 static char **regstartp;	/* Pointer to startp array. */
@@ -112,7 +123,6 @@ int safebase;	/* no need to remember string in subbase */
 	register int tmp;
 	int minlen = 0;		/* must match at least this many chars */
 	int dontbother = 0;	/* how many characters not to try at end */
-	int beginning = (string == strbeg);	/* is ^ valid at stringarg? */
 
 	/* Be paranoid... */
 	if (prog == NULL || string == NULL) {
@@ -120,6 +130,10 @@ int safebase;	/* no need to remember string in subbase */
 		return(0);
 	}
 
+	if (string == strbeg)	/* is ^ valid at stringarg? */
+	    regprev = '\n';
+	else
+	    regprev = stringarg[-1];
 	regprecomp = prog->precomp;
 	/* Check validity of program. */
 	if (UCHARAT(prog->program) != MAGIC) {
@@ -134,14 +148,14 @@ int safebase;	/* no need to remember string in subbase */
 		string = c;
 		strend = string + i;
 		for (s = string; s < strend; s++)
-			if (isupper(*s))
+			if (isUPPER(*s))
 				*s = tolower(*s);
 	}
 
 	/* If there is a "must appear" string, look for it. */
 	s = string;
 	if (prog->regmust != Nullstr) {
-		if (beginning && screamer) {
+		if (stringarg == strbeg && screamer) {
 			if (screamfirst[prog->regmust->str_rare] >= 0)
 				s = screaminstr(screamer,prog->regmust);
 			else
@@ -174,10 +188,7 @@ int safebase;	/* no need to remember string in subbase */
 	}
 
 	/* Mark beginning of line for ^ . */
-	if (beginning)
-		regbol = string;
-	else
-		regbol = NULL;
+	regbol = string;
 
 	/* Mark end of line for $ (and such) */
 	regeol = strend;
@@ -243,7 +254,7 @@ int safebase;	/* no need to remember string in subbase */
 		case ANYOF: case ANYBUT:
 		    c = OPERAND(c);
 		    while (s < strend) {
-			    i = *s;
+			    i = UCHARAT(s);
 			    if (!(c[i >> 3] & (1 << (i&7))))
 				    if (regtry(prog, s))
 					    goto got_it;
@@ -255,13 +266,13 @@ int safebase;	/* no need to remember string in subbase */
 			dontbother++,strend--;
 		    if (s != string) {
 			i = s[-1];
-			tmp = (isalpha(i) || isdigit(i) || i == '_');
+			tmp = isALNUM(i);
 		    }
 		    else
-			tmp = 0;	/* assume not alphanumeric */
+			tmp = isALNUM(regprev);	/* assume not alphanumeric */
 		    while (s < strend) {
 			    i = *s;
-			    if (tmp != (isalpha(i) || isdigit(i) || i == '_')) {
+			    if (tmp != isALNUM(i)) {
 				    tmp = !tmp;
 				    if (regtry(prog, s))
 					    goto got_it;
@@ -276,13 +287,13 @@ int safebase;	/* no need to remember string in subbase */
 			dontbother++,strend--;
 		    if (s != string) {
 			i = s[-1];
-			tmp = (isalpha(i) || isdigit(i) || i == '_');
+			tmp = isALNUM(i);
 		    }
 		    else
-			tmp = 0;	/* assume not alphanumeric */
+			tmp = isALNUM(regprev);	/* assume not alphanumeric */
 		    while (s < strend) {
 			    i = *s;
-			    if (tmp != (isalpha(i) || isdigit(i) || i == '_'))
+			    if (tmp != isALNUM(i))
 				    tmp = !tmp;
 			    else if (regtry(prog, s))
 				    goto got_it;
@@ -294,7 +305,7 @@ int safebase;	/* no need to remember string in subbase */
 		case ALNUM:
 		    while (s < strend) {
 			    i = *s;
-			    if (isalpha(i) || isdigit(i) || i == '_')
+			    if (isALNUM(i))
 				    if (regtry(prog, s))
 					    goto got_it;
 			    s++;
@@ -303,7 +314,7 @@ int safebase;	/* no need to remember string in subbase */
 		case NALNUM:
 		    while (s < strend) {
 			    i = *s;
-			    if (!isalpha(i) && !isdigit(i) && i != '_')
+			    if (!isALNUM(i))
 				    if (regtry(prog, s))
 					    goto got_it;
 			    s++;
@@ -311,7 +322,7 @@ int safebase;	/* no need to remember string in subbase */
 		    break;
 		case SPACE:
 		    while (s < strend) {
-			    if (isspace(*s))
+			    if (isSPACE(*s))
 				    if (regtry(prog, s))
 					    goto got_it;
 			    s++;
@@ -319,7 +330,7 @@ int safebase;	/* no need to remember string in subbase */
 		    break;
 		case NSPACE:
 		    while (s < strend) {
-			    if (!isspace(*s))
+			    if (!isSPACE(*s))
 				    if (regtry(prog, s))
 					    goto got_it;
 			    s++;
@@ -327,7 +338,7 @@ int safebase;	/* no need to remember string in subbase */
 		    break;
 		case DIGIT:
 		    while (s < strend) {
-			    if (isdigit(*s))
+			    if (isDIGIT(*s))
 				    if (regtry(prog, s))
 					    goto got_it;
 			    s++;
@@ -335,7 +346,7 @@ int safebase;	/* no need to remember string in subbase */
 		    break;
 		case NDIGIT:
 		    while (s < strend) {
-			    if (!isdigit(*s))
+			    if (!isDIGIT(*s))
 				    if (regtry(prog, s))
 					    goto got_it;
 			    s++;
@@ -471,7 +482,7 @@ char *prog;
 
 		switch (OP(scan)) {
 		case BOL:
-			if (locinput == regbol ||
+			if (locinput == regbol ? regprev == '\n' :
 			    ((nextchar || locinput < regeol) &&
 			      locinput[-1] == '\n') )
 			{
@@ -517,55 +528,50 @@ char *prog;
 		case ALNUM:
 			if (!nextchar)
 				return(0);
-			if (!isalpha(nextchar) && !isdigit(nextchar) &&
-			  nextchar != '_')
+			if (!isALNUM(nextchar))
 				return(0);
 			nextchar = *++locinput;
 			break;
 		case NALNUM:
 			if (!nextchar && locinput >= regeol)
 				return(0);
-			if (isalpha(nextchar) || isdigit(nextchar) ||
-			  nextchar == '_')
+			if (isALNUM(nextchar))
 				return(0);
 			nextchar = *++locinput;
 			break;
 		case NBOUND:
 		case BOUND:
 			if (locinput == regbol)	/* was last char in word? */
-				ln = 0;
+				ln = isALNUM(regprev);
 			else 
-				ln = (isalpha(locinput[-1]) ||
-				     isdigit(locinput[-1]) ||
-				     locinput[-1] == '_' );
-			n = (isalpha(nextchar) || isdigit(nextchar) ||
-			    nextchar == '_' );	/* is next char in word? */
+				ln = isALNUM(locinput[-1]);
+			n = isALNUM(nextchar); /* is next char in word? */
 			if ((ln == n) == (OP(scan) == BOUND))
 				return(0);
 			break;
 		case SPACE:
 			if (!nextchar && locinput >= regeol)
 				return(0);
-			if (!isspace(nextchar))
+			if (!isSPACE(nextchar))
 				return(0);
 			nextchar = *++locinput;
 			break;
 		case NSPACE:
 			if (!nextchar)
 				return(0);
-			if (isspace(nextchar))
+			if (isSPACE(nextchar))
 				return(0);
 			nextchar = *++locinput;
 			break;
 		case DIGIT:
-			if (!isdigit(nextchar))
+			if (!isDIGIT(nextchar))
 				return(0);
 			nextchar = *++locinput;
 			break;
 		case NDIGIT:
 			if (!nextchar && locinput >= regeol)
 				return(0);
-			if (isdigit(nextchar))
+			if (isDIGIT(nextchar))
 				return(0);
 			nextchar = *++locinput;
 			break;
@@ -762,28 +768,27 @@ char *p;
 		}
 		break;
 	case ALNUM:
-		while (isalpha(*scan) || isdigit(*scan) || *scan == '_')
+		while (isALNUM(*scan))
 			scan++;
 		break;
 	case NALNUM:
-		while (scan < loceol && (!isalpha(*scan) && !isdigit(*scan) &&
-		  *scan != '_'))
+		while (scan < loceol && !isALNUM(*scan))
 			scan++;
 		break;
 	case SPACE:
-		while (scan < loceol && isspace(*scan))
+		while (scan < loceol && isSPACE(*scan))
 			scan++;
 		break;
 	case NSPACE:
-		while (scan < loceol && !isspace(*scan))
+		while (scan < loceol && !isSPACE(*scan))
 			scan++;
 		break;
 	case DIGIT:
-		while (isdigit(*scan))
+		while (isDIGIT(*scan))
 			scan++;
 		break;
 	case NDIGIT:
-		while (scan < loceol && !isdigit(*scan))
+		while (scan < loceol && !isDIGIT(*scan))
 			scan++;
 		break;
 	default:		/* Oh dear.  Called inappropriately. */
diff --git a/t/io.pipe b/t/io.pipe
index 49eaeec959..d972abab18 100644
--- a/t/io.pipe
+++ b/t/io.pipe
@@ -1,9 +1,9 @@
 #!./perl
 
-# $Header: io.pipe,v 3.0 89/10/18 15:26:30 lwall Locked $
+# $Header: io.pipe,v 3.0.1.1 90/02/28 18:32:41 lwall Locked $
 
 $| = 1;
-print "1..4\n";
+print "1..8\n";
 
 open(PIPE, "|-") || (exec 'tr', '[A-Z]', '[a-z]');
 print PIPE "OK 1\n";
@@ -12,10 +12,45 @@ close PIPE;
 
 if (open(PIPE, "-|")) {
     while(<PIPE>) {
+	s/^not //;
 	print;
     }
 }
 else {
-    print STDOUT "ok 3\n";
-    exec 'echo', 'ok 4';
+    print STDOUT "not ok 3\n";
+    exec 'echo', 'not ok 4';
 }
+
+pipe(READER,WRITER) || die "Can't open pipe";
+
+if ($pid = fork) {
+    close WRITER;
+    while(<READER>) {
+	s/^not //;
+	y/A-Z/a-z/;
+	print;
+    }
+}
+else {
+    die "Couldn't fork" unless defined $pid;
+    close READER;
+    print WRITER "not ok 5\n";
+    open(STDOUT,">&WRITER") || die "Can't dup WRITER to STDOUT";
+    close WRITER;
+    exec 'echo', 'not ok 6';
+}
+
+
+pipe(READER,WRITER) || die "Can't open pipe";
+close READER;
+
+$SIG{'PIPE'} = 'broken_pipe';
+
+sub broken_pipe {
+    print "ok 7\n";
+}
+
+print WRITER "not ok 7\n";
+close WRITER;
+
+print "ok 8\n";
diff --git a/t/op.mkdir b/t/op.mkdir
index 99e04b0057..7c13e994dd 100644
--- a/t/op.mkdir
+++ b/t/op.mkdir
@@ -1,6 +1,6 @@
 #!./perl
 
-# $Header: op.mkdir,v 3.0.1.1 89/11/11 05:00:47 lwall Locked $
+# $Header: op.mkdir,v 3.0.1.2 90/02/28 18:35:31 lwall Locked $
 
 print "1..7\n";
 
@@ -12,4 +12,4 @@ print ($! =~ /exists/ ? "ok 3\n" : "not ok 3\n");
 print (-d 'blurfl' ? "ok 4\n" : "not ok 4\n");
 print (rmdir('blurfl') ? "ok 5\n" : "not ok 5\n");
 print (rmdir('blurfl') ? "not ok 6\n" : "ok 6\n");
-print ($! =~ /such/ ? "ok 7\n" : "not ok 7\n");
+print ($! =~ /such|exist/ ? "ok 7\n" : "not ok 7\n");
diff --git a/t/op.stat b/t/op.stat
index 064f1b8106..f5e61647b6 100644
--- a/t/op.stat
+++ b/t/op.stat
@@ -1,6 +1,6 @@
 #!./perl
 
-# $Header: op.stat,v 3.0.1.2 89/11/17 15:39:27 lwall Locked $
+# $Header: op.stat,v 3.0.1.3 90/02/28 18:36:51 lwall Locked $
 
 print "1..56\n";
 
@@ -88,11 +88,15 @@ if (! -b '.') {print "ok 34\n";} else {print "not ok 34\n";}
 
 $cnt = $uid = 0;
 
-while (</usr/bin/*>) {
+chop($cwd = `pwd`);
+die "Can't run op.stat test 35 without pwd working" unless $cwd;
+chdir '/usr/bin' || die "Can't cd to /usr/bin";
+while (<*>) {
     $cnt++;
     $uid++ if -u;
     last if $uid && $uid < $cnt;
 }
+chdir $cwd || die "Can't cd back to $cwd";
 
 # I suppose this is going to fail somewhere...
 if ($uid > 0 && $uid < $cnt) {print "ok 35\n";} else {print "not ok 35\n";}
diff --git a/t/op.subst b/t/op.subst
index e3bf6e2209..a3d45ea506 100644
--- a/t/op.subst
+++ b/t/op.subst
@@ -1,6 +1,6 @@
 #!./perl
 
-# $Header: op.subst,v 3.0 89/10/18 15:31:43 lwall Locked $
+# $Header: op.subst,v 3.0.1.1 90/02/28 18:37:30 lwall Locked $
 
 print "1..42\n";
 
@@ -42,7 +42,7 @@ if (/a/i && s///gi && $_ eq 'BCD') {print "ok 8\n";} else {print "not ok 8 $_\n"
 $_ = '\\' x 4;
 if (length($_) == 4) {print "ok 9\n";} else {print "not ok 9\n";}
 s/\\/\\\\/g;
-if ($_ eq '\\' x 8) {print "ok 10\n";} else {print "not ok 10\n";}
+if ($_ eq '\\' x 8) {print "ok 10\n";} else {print "not ok 10 $_\n";}
 
 $_ = '\/' x 4;
 if (length($_) == 8) {print "ok 11\n";} else {print "not ok 11\n";}