perl 4.0 patch 7: patch #4, continued

See patch #4.

19 files changed, 534 insertions, 272 deletions

diff --git a/emacs/perl-mode.el b/emacs/perl-mode.el
index 5d7078cf3c..cb6195dec3 100644
--- a/emacs/perl-mode.el
+++ b/emacs/perl-mode.el
@@ -572,7 +572,7 @@ Returns new value of point in all cases."
   (or arg (setq arg 1))
   (if (< arg 0) (forward-char 1))
   (and (/= arg 0)
-       (re-search-backward "^\\s(\\|^\\s-*sub\\b[^{]+{\\|^\\s-*format\\b[^=]*="
+       (re-search-backward "^\\s(\\|^\\s-*sub\\b[^{]+{\\|^\\s-*format\\b[^=]*=\\|^\\."
 			   nil 'move arg)
        (goto-char (1- (match-end 0))))
   (point))
diff --git a/h2pl/mkvars b/h2pl/mkvars
index c6b5ad14da..ffb0f0b0b9 100644
--- a/h2pl/mkvars
+++ b/h2pl/mkvars
@@ -19,7 +19,7 @@ foreach $include (@ARGV) {
 	    $val = eval "&$var;";
 	    if ($@) {
 		warn "$@: $_";
-		print <<EOT
+		print <<EOT;
 warn "\$$var isn't correctly set" if defined \$_main{'$var'};
 EOT
 		next;
diff --git a/hash.h b/hash.h
index c2f9b554f4..837cc96e0e 100644
--- a/hash.h
+++ b/hash.h
@@ -1,11 +1,14 @@
-/* $Header: hash.h,v 4.0 91/03/20 01:22:38 lwall Locked $
+/* $RCSfile: hash.h,v $$Revision: 4.0.1.1 $$Date: 91/06/07 11:10:33 $
  *
- *    Copyright (c) 1989, Larry Wall
+ *    Copyright (c) 1991, Larry Wall
  *
- *    You may distribute under the terms of the GNU General Public License
- *    as specified in the README file that comes with the perl 3.0 kit.
+ *    You may distribute under the terms of either the GNU General Public
+ *    License or the Artistic License, as specified in the README file.
  *
  * $Log:	hash.h,v $
+ * Revision 4.0.1.1  91/06/07  11:10:33  lwall
+ * patch4: new copyright notice
+ * 
  * Revision 4.0  91/03/20  01:22:38  lwall
  * 4.0 baseline.
  * 
diff --git a/hints/hpux.sh b/hints/hpux.sh
index 83a149ce1e..cab5871429 100644
--- a/hints/hpux.sh
+++ b/hints/hpux.sh
@@ -1,4 +1,7 @@
-d_syscall=$undef
 echo " "
 echo "NOTE: regression test op.read may fail due to an NFS bug in HP/UX."
 echo "If so, don't worry about it."
+case `(uname -r) 2>/dev/null` in
+*3.1*) d_syscall=$undef ;;
+*2.1*) libswanted=`echo $libswanted | sed 's/ malloc / /'` ;;
+esac
diff --git a/hints/mips.sh b/hints/mips.sh
index 623b6f080b..ddb2694658 100644
--- a/hints/mips.sh
+++ b/hints/mips.sh
@@ -1,6 +1,17 @@
-optimize='-g'
+cmd_cflags='optimize="-g"'
+perl_cflags='optimize="-g"'
+tcmd_cflags='optimize="-g"'
+tperl_cflags='optimize="-g"'
 d_volatile=undef
 d_castneg=undef
 cc=cc
 libpth="/usr/lib/cmplrs/cc $libpth"
 groupstype=int
+nm_opts='-B'
+case $PATH in
+*bsd*:/bin:*) cat <<END
+NOTE:  Some people have reported having much better luck with Mips CC than
+with the BSD cc.  Put /bin first in your PATH if you have difficulties.
+END
+;;
+esac
diff --git a/hints/next.sh b/hints/next.sh
index 6e919cd504..8c77055ba3 100644
--- a/hints/next.sh
+++ b/hints/next.sh
@@ -1,2 +1,4 @@
 : Just disable defaulting to -fpcc-struct-return, since gcc is native compiler.
-ccflags="$ccflags "
+nativegcc='define'
+groupstype="int"
+usemymalloc="n"
diff --git a/installperl b/installperl
index 37f19cd9ea..633ff266a1 100644
--- a/installperl
+++ b/installperl
@@ -6,8 +6,8 @@ while (@ARGV) {
     shift;
 }
 
-@scripts = 'h2ph';
-@manpages = ('perl.man', 'h2ph.man');
+@scripts = ('h2ph', 'x2p/s2p', 'x2p/find2perl');
+@manpages = ('perl.man', 'h2ph.man', 'x2p/a2p.man', 'x2p/s2p.man');
 
 $version = sprintf("%5.3f", $]);
 $release = substr($version,0,3);
@@ -72,6 +72,14 @@ if ($bdev != $ddev || $bino != $dino) {
     &link("$installbin/sperl$ver", "$installbin/suidperl") if $d_dosuid;
 }
 
+($bdev,$bino) = stat($installbin);
+($ddev,$dino) = stat('x2p');
+
+if ($bdev != $ddev || $bino != $dino) {
+    &unlink("$installbin/a2p");
+    &cmd("cp x2p/a2p $installbin/a2p");
+}
+
 # Make some enemies in the name of standardization.   :-)
 
 ($udev,$uino) = stat("/usr/bin");
@@ -85,11 +93,11 @@ if (-w _ && ($udev != $ddev || $uino != $dino) && !$nonono) {
 
 # Install scripts.
 
-&makedir($scriptdir);
+&makedir($installscr);
 
 for (@scripts) {
-    &cmd("cp $_ $scriptdir");
-    &chmod(0755, "$scriptdir/$_");
+    &cmd("cp $_ $installscr");
+    s#.*/##; &chmod(0755, "$installscr/$_");
 }
 
 # Install library files.
@@ -111,6 +119,7 @@ if ($mansrc ne '') {
     if ($mdev != $ddev || $mino != $dino) {
 	for (@manpages) {
 	    ($new = $_) =~ s/man$/$manext/;
+	    $new =~ s#.*/##;
 	    print STDERR "  Installing $mansrc/$new\n";
 	    next if $nonono;
 	    open(MI,$_);
diff --git a/lib/newgetopt.pl b/lib/newgetopt.pl
new file mode 100644
index 0000000000..441213a538
--- /dev/null
+++ b/lib/newgetopt.pl
@@ -0,0 +1,204 @@
+# newgetopt.pl -- new options parsing
+
+# SCCS Status     : @(#)@ newgetopt.pl	1.7
+# Author          : Johan Vromans
+# Created On      : Tue Sep 11 15:00:12 1990
+# Last Modified By: Johan Vromans
+# Last Modified On: Sun Oct 14 14:35:36 1990
+# Update Count    : 34
+# Status          : Okay
+
+# This package implements a new getopt function. This function adheres
+# to the new syntax (long option names, no bundling).
+#
+# Arguments to the function are:
+#
+#  - a list of possible options. These should designate valid perl
+#    identifiers, optionally followed by an argument specifier ("="
+#    for mandatory arguments or ":" for optional arguments) and an
+#    argument type specifier: "n" or "i" for integer numbers, "f" for
+#    real (fix) numbers or "s" for strings.
+#
+#  - if the first option of the list consists of non-alphanumeric
+#    characters only, it is interpreted as a generic option starter.
+#    Everything starting with one of the characters from the starter
+#    will be considered an option.
+#    Likewise, a double occurrence (e.g. "--") signals end of
+#    the options list.
+#    The default value for the starter is "-".
+#
+# Upon return, the option variables, prefixed with "opt_", are defined
+# and set to the respective option arguments, if any.
+# Options that do not take an argument are set to 1. Note that an
+# option with an optional argument will be defined, but set to '' if
+# no actual argument has been supplied.
+# A return status of 0 (false) indicates that the function detected
+# one or more errors.
+#
+# Special care is taken to give a correct treatment to optional arguments.
+#
+# E.g. if option "one:i" (i.e. takes an optional integer argument),
+# then the following situations are handled:
+#
+#    -one -two		-> $opt_one = '', -two is next option
+#    -one -2		-> $opt_one = -2
+#
+# Also, assume "foo=s" and "bar:s" :
+#
+#    -bar -xxx		-> $opt_bar = '', '-xxx' is next option
+#    -foo -bar		-> $opt_foo = '-bar'
+#    -foo --		-> $opt_foo = '--'
+#
+
+# HISTORY 
+# 20-Sep-1990		Johan Vromans	
+#    Set options w/o argument to 1.
+#    Correct the dreadful semicolon/require bug.
+
+
+package newgetopt;
+
+$debug = 0;			# for debugging
+
+sub main'NGetOpt {
+    local (@optionlist) = @_;
+    local ($[) = 0;
+    local ($genprefix) = "-";
+    local ($error) = 0;
+    local ($opt, $optx, $arg, $type, $mand, @hits);
+
+    # See if the first element of the optionlist contains option
+    # starter characters.
+    $genprefix = shift (@optionlist) if $optionlist[0] =~ /^\W+$/;
+
+    # Turn into regexp.
+    $genprefix =~ s/(\W)/\\\1/g;
+    $genprefix = "[" . $genprefix . "]";
+
+    # Verify correctness of optionlist.
+    @hits = grep ($_ !~ /^\w+([=:][infse])?$/, @optionlist);
+    if ( $#hits >= 0 ) {
+	foreach $opt ( @hits ) {
+	    print STDERR ("Error in option spec: \"", $opt, "\"\n");
+	    $error++;
+	}
+	return 0;
+    }
+
+    # Process argument list
+
+    while ( $#main'ARGV >= 0 ) {		#'){
+
+	# >>> See also the continue block <<<
+
+	# Get next argument
+	$opt = shift (@main'ARGV);		#');
+	print STDERR ("=> option \"", $opt, "\"\n") if $debug;
+	$arg = undef;
+
+	# Check for exhausted list.
+	if ( $opt =~ /^$genprefix/o ) {
+	    # Double occurrence is terminator
+	    return ($error == 0) if $opt eq "$+$+";
+	    $opt = $';		# option name (w/o prefix)
+	}
+	else {
+	    # Apparently not an option - push back and exit.
+	    unshift (@main'ARGV, $opt);		#');
+	    return ($error == 0);
+	}
+
+	# Grep in option list. Hide regexp chars from option.
+	($optx = $opt) =~ s/(\W)/\\\1/g;
+	@hits = grep (/^$optx([=:].+)?$/, @optionlist);
+	if ( $#hits != 0 ) {
+	    print STDERR ("Unknown option: ", $opt, "\n");
+	    $error++;
+	    next;
+	}
+
+	# Determine argument status.
+	undef $type;
+	$type = $+ if $hits[0] =~ /[=:].+$/;
+	print STDERR ("=> found \"$hits[0]\" for ", $opt, "\n") if $debug;
+
+	# If it is an option w/o argument, we're almost finished with it.
+	if ( ! defined $type ) {
+	    $arg = 1;		# supply explicit value
+	    next;
+	}
+
+	# Get mandatory status and type info.
+	($mand, $type) = $type =~ /^(.)(.)$/;
+
+	# Check if the argument list is exhausted.
+	if ( $#main'ARGV < 0 ) {		#'){
+
+	    # Complain if this option needs an argument.
+	    if ( $mand eq "=" ) {
+		print STDERR ("Option ", $opt, " requires an argument\n");
+		$error++;
+	    }
+	    next;
+	}
+
+	# Get (possibly optional) argument.
+	$arg = shift (@main'ARGV);		#');
+
+	# Check if it is a valid argument. A mandatory string takes
+ 	# anything. 
+	if ( "$mand$type" ne "=s" && $arg =~ /^$genprefix/o ) {
+
+	    # Check for option list terminator.
+	    if ( $arg eq "$+$+" ) {
+		# Complain if an argument is required.
+		if ($mand eq "=") {
+		    print STDERR ("Option ", $opt, " requires an argument\n");
+		    $error++;
+		}
+		# Push back so the outer loop will terminate.
+		unshift (@main'ARGV, $arg);	#');
+		$arg = "";	# don't assign it
+		next;
+	    }
+
+	    # Maybe the optional argument is the next option?
+	    if ( $mand eq ":" && $' =~ /[a-zA-Z_]/ ) {
+		# Yep. Push back.
+		unshift (@main'ARGV, $arg);	#');
+		$arg = "";	# don't assign it
+		next;
+	    }
+	}
+
+	if ( $type eq "n" || $type eq "i" ) { # numeric/integer
+	    if ( $arg !~ /^-?[0-9]+$/ ) {
+		print STDERR ("Value \"", $arg, "\" invalid for option ",
+			       $opt, " (numeric required)\n");
+		$error++;
+	    }
+	    next;
+	}
+
+	if ( $type eq "f" ) { # fixed real number, int is also ok
+	    if ( $arg !~ /^-?[0-9.]+$/ ) {
+		print STDERR ("Value \"", $arg, "\" invalid for option ",
+			       $opt, " (real number required)\n");
+		$error++;
+	    }
+	    next;
+	}
+
+	if ( $type eq "s" ) { # string
+	    next;
+	}
+
+    }
+    continue {
+	print STDERR ("=> \$main'opt_$opt = $arg\n") if $debug;
+	eval ("\$main'opt_$opt = \$arg");
+    }
+
+    return ($error == 0);
+}
+1;
diff --git a/makedepend.SH b/makedepend.SH
index 8ab772df8e..2f941758b3 100644
--- a/makedepend.SH
+++ b/makedepend.SH
@@ -15,9 +15,15 @@ esac
 echo "Extracting makedepend (with variable substitutions)"
 $spitshell >makedepend <<!GROK!THIS!
 $startsh
-# $Header: makedepend.SH,v 4.0 91/03/20 01:27:04 lwall Locked $
+# $RCSfile: makedepend.SH,v $$Revision: 4.0.1.2 $$Date: 91/06/07 15:40:06 $
 #
 # $Log:	makedepend.SH,v $
+# Revision 4.0.1.2  91/06/07  15:40:06  lwall
+# patch4: fixed cppstdin to run in the right directory
+# 
+# Revision 4.0.1.1  91/06/07  11:20:06  lwall
+# patch4: Makefile is no longer self-modifying code under makedepend
+# 
 # Revision 4.0  91/03/20  01:27:04  lwall
 # 4.0 baseline.
 # 
@@ -28,7 +34,8 @@ export PATH || (echo "OOPS, this isn't sh.  Desperation time.  I will feed mysel
 cat='$cat'
 cppflags='$cppflags'
 cp='$cp'
-cpp='$cppstdin'
+cppstdin='$cppstdin'
+cppminus='$cppminus'
 echo='$echo'
 egrep='$egrep'
 expr='$expr'
@@ -46,10 +53,9 @@ $spitshell >>makedepend <<'!NO!SUBS!'
 $cat /dev/null >.deptmp
 $rm -f *.c.c c/*.c.c
 if test -f Makefile; then
-    mf=Makefile
-else
-    mf=makefile
+    cp Makefile makefile
 fi
+mf=makefile
 if test -f $mf; then
     defrule=`<$mf sed -n		\
 	-e '/^\.c\.o:.*;/{'		\
@@ -84,7 +90,7 @@ for file in `$cat .clist`; do
 	-e 's|\\$||' \
 	-e p \
 	-e '}'
-    $cpp -I/usr/local/include -I. $cppflags $file.c | \
+    $cppstdin -I/usr/local/include -I. $cppflags $cppminus <$file.c | sed -e 's#\.[0-9][0-9]*\.c#'"$file.c#" | \
     $sed \
 	-e '/^# *[0-9]/!d' \
 	-e 's/^.*"\(.*\)".*$/'$filebase'.o: \1/' \
@@ -93,52 +99,52 @@ for file in `$cat .clist`; do
     $uniq | $sort | $uniq >> .deptmp
 done
 
-$sed <Makefile >Makefile.new -e '1,/^# AUTOMATICALLY/!d'
+$sed <$mf >$mf.new -e '1,/^# AUTOMATICALLY/!d'
 
 make shlist || ($echo "Searching for .SH files..."; \
 	$echo *.SH | $tr ' ' '\012' | $egrep -v '\*' >.shlist)
 if $test -s .deptmp; then
     for file in `cat .shlist`; do
-	$echo `$expr X$file : 'X\(.*\).SH`: $file config.sh \; \
+	$echo `$expr X$file : 'X\(.*\).SH'`: $file config.sh \; \
 	    /bin/sh $file >> .deptmp
     done
-    $echo "Updating Makefile..."
+    $echo "Updating $mf..."
     $echo "# If this runs make out of memory, delete /usr/include lines." \
-	>> Makefile.new
+	>> $mf.new
     $sed 's|^\(.*\.o:\) *\(.*/.*\.c\) *$|\1 \2; '"$defrule \2|" .deptmp \
-       >>Makefile.new
+       >>$mf.new
 else
     make hlist || ($echo "Searching for .h files..."; \
 	$echo *.h | $tr ' ' '\012' | $egrep -v '\*' >.hlist)
     $echo "You don't seem to have a proper C preprocessor.  Using grep instead."
     $egrep '^#include ' `cat .clist` `cat .hlist`  >.deptmp
-    $echo "Updating Makefile..."
+    $echo "Updating $mf..."
     <.clist $sed -n							\
 	-e '/\//{'							\
 	-e   's|^\(.*\)/\(.*\)\.c|\2.o: \1/\2.c; '"$defrule \1/\2.c|p"	\
 	-e   d								\
 	-e '}'								\
-	-e 's|^\(.*\)\.c|\1.o: \1.c|p' >> Makefile.new
+	-e 's|^\(.*\)\.c|\1.o: \1.c|p' >> $mf.new
     <.hlist $sed -n 's|\(.*/\)\(.*\)|s= \2= \1\2=|p' >.hsed
     <.deptmp $sed -n 's|c:#include "\(.*\)".*$|o: \1|p' | \
        $sed 's|^[^;]*/||' | \
-       $sed -f .hsed >> Makefile.new
+       $sed -f .hsed >> $mf.new
     <.deptmp $sed -n 's|c:#include <\(.*\)>.*$|o: /usr/include/\1|p' \
-       >> Makefile.new
+       >> $mf.new
     <.deptmp $sed -n 's|h:#include "\(.*\)".*$|h: \1|p' | \
-       $sed -f .hsed >> Makefile.new
+       $sed -f .hsed >> $mf.new
     <.deptmp $sed -n 's|h:#include <\(.*\)>.*$|h: /usr/include/\1|p' \
-       >> Makefile.new
+       >> $mf.new
     for file in `$cat .shlist`; do
-	$echo `$expr X$file : 'X\(.*\).SH`: $file config.sh \; \
-	    /bin/sh $file >> Makefile.new
+	$echo `$expr X$file : 'X\(.*\).SH'`: $file config.sh \; \
+	    /bin/sh $file >> $mf.new
     done
 fi
-$rm -f Makefile.old
-$cp Makefile Makefile.old
-$cp Makefile.new Makefile
-$rm Makefile.new
-$echo "# WARNING: Put nothing here or make depend will gobble it up!" >> Makefile
+$rm -f $mf.old
+$cp $mf $mf.old
+$cp $mf.new $mf
+$rm $mf.new
+$echo "# WARNING: Put nothing here or make depend will gobble it up!" >> $mf
 $rm -f .deptmp `sed 's/\.c/.c.c/' .clist` .shlist .clist .hlist .hsed
 
 !NO!SUBS!
diff --git a/malloc.c b/malloc.c
index fece175e00..72a265ed6e 100644
--- a/malloc.c
+++ b/malloc.c
@@ -1,6 +1,9 @@
-/* $RCSfile: malloc.c,v $$Revision: 4.0.1.1 $$Date: 91/04/11 17:48:31 $
+/* $RCSfile: malloc.c,v $$Revision: 4.0.1.2 $$Date: 91/06/07 11:20:45 $
  *
  * $Log:	malloc.c,v $
+ * Revision 4.0.1.2  91/06/07  11:20:45  lwall
+ * patch4: many, many itty-bitty portability fixes
+ * 
  * Revision 4.0.1.1  91/04/11  17:48:31  lwall
  * patch1: Configure now figures out malloc ptr type
  * 
@@ -160,7 +163,7 @@ malloc(nbytes)
 	p->ov_rmagic = RMAGIC;
   	*((u_int *)((caddr_t)p + nbytes - RSLOP)) = RMAGIC;
 #endif
-  	return ((char *)(p + 1));
+  	return ((MALLOCPTRTYPE *)(p + 1));
 }
 
 /*
@@ -230,11 +233,12 @@ morecore(bucket)
 }
 
 void
-free(cp)
-	char *cp;
+free(mp)
+	MALLOCPTRTYPE *mp;
 {   
   	register int size;
 	register union overhead *op;
+	char *cp = (char*)mp;
 
   	if (cp == NULL)
   		return;
@@ -277,8 +281,8 @@ free(cp)
 int reall_srchlen = 4;	/* 4 should be plenty, -1 =>'s whole list */
 
 MALLOCPTRTYPE *
-realloc(cp, nbytes)
-	char *cp; 
+realloc(mp, nbytes)
+	MALLOCPTRTYPE *mp; 
 	unsigned nbytes;
 {   
   	register u_int onb;
@@ -286,6 +290,7 @@ realloc(cp, nbytes)
   	char *res;
 	register int i;
 	int was_alloced = 0;
+	char *cp = (char*)mp;
 
   	if (cp == NULL)
   		return (malloc(nbytes));
@@ -331,15 +336,15 @@ realloc(cp, nbytes)
 			*((u_int *)((caddr_t)op + nbytes - RSLOP)) = RMAGIC;
 		}
 #endif
-		return(cp);
+		return((MALLOCPTRTYPE*)cp);
 	}
-  	if ((res = malloc(nbytes)) == NULL)
+  	if ((res = (char*)malloc(nbytes)) == NULL)
   		return (NULL);
   	if (cp != res)			/* common optimization */
 		(void)bcopy(cp, res, (int)((nbytes < onb) ? nbytes : onb));
   	if (was_alloced)
 		free(cp);
-  	return (res);
+  	return ((MALLOCPTRTYPE*)res);
 }
 
 /*
diff --git a/msdos/msdos.c b/msdos/msdos.c
index bfe2764531..754c7efcec 100644
--- a/msdos/msdos.c
+++ b/msdos/msdos.c
@@ -1,11 +1,14 @@
-/* $Header: msdos.c,v 4.0 91/03/20 01:34:46 lwall Locked $
+/* $RCSfile: msdos.c,v $$Revision: 4.0.1.1 $$Date: 91/06/07 11:22:37 $
  *
  *    (C) Copyright 1989, 1990 Diomidis Spinellis.
  *
- *    You may distribute under the terms of the GNU General Public License
- *    as specified in the README file that comes with the perl 3.0 kit.
+ *    You may distribute under the terms of either the GNU General Public
+ *    License or the Artistic License, as specified in the README file.
  *
  * $Log:	msdos.c,v $
+ * Revision 4.0.1.1  91/06/07  11:22:37  lwall
+ * patch4: new copyright notice
+ * 
  * Revision 4.0  91/03/20  01:34:46  lwall
  * 4.0 baseline.
  * 
diff --git a/os2/os2.c b/os2/os2.c
index b8e240e9a7..bd31a24afa 100644
--- a/os2/os2.c
+++ b/os2/os2.c
@@ -1,11 +1,14 @@
-/* $Header: os2.c,v 4.0 91/03/20 01:36:21 lwall Locked $
+/* $RCSfile: os2.c,v $$Revision: 4.0.1.1 $$Date: 91/06/07 11:23:06 $
  *
  *    (C) Copyright 1989, 1990 Diomidis Spinellis.
  *
- *    You may distribute under the terms of the GNU General Public License
- *    as specified in the README file that comes with the perl 3.0 kit.
+ *    You may distribute under the terms of either the GNU General Public
+ *    License or the Artistic License, as specified in the README file.
  *
  * $Log:	os2.c,v $
+ * Revision 4.0.1.1  91/06/07  11:23:06  lwall
+ * patch4: new copyright notice
+ * 
  * Revision 4.0  91/03/20  01:36:21  lwall
  * 4.0 baseline.
  * 
diff --git a/patchlevel.h b/patchlevel.h
index fb8ed65ede..e19cd94440 100644
--- a/patchlevel.h
+++ b/patchlevel.h
@@ -1 +1 @@
-#define PATCHLEVEL 6
+#define PATCHLEVEL 7
diff --git a/perl.c b/perl.c
index 11ba0f66e8..e489159b57 100644
--- a/perl.c
+++ b/perl.c
@@ -1,11 +1,20 @@
-char rcsid[] = "$RCSfile: perl.c,v $$Revision: 4.0.1.1 $$Date: 91/04/11 17:49:05 $\nPatch level: ###\n";
+char rcsid[] = "$RCSfile: perl.c,v $$Revision: 4.0.1.3 $$Date: 91/06/07 11:40:18 $\nPatch level: ###\n";
 /*
- *    Copyright (c) 1989, Larry Wall
+ *    Copyright (c) 1991, Larry Wall
  *
- *    You may distribute under the terms of the GNU General Public License
- *    as specified in the README file that comes with the perl 3.0 kit.
+ *    You may distribute under the terms of either the GNU General Public
+ *    License or the Artistic License, as specified in the README file.
  *
  * $Log:	perl.c,v $
+ * Revision 4.0.1.3  91/06/07  11:40:18  lwall
+ * patch4: changed old $^P to $^X
+ * 
+ * Revision 4.0.1.2  91/06/07  11:26:16  lwall
+ * patch4: new copyright notice
+ * patch4: added $^P variable to control calling of perldb routines
+ * patch4: added $^F variable to specify maximum system fd, default 2
+ * patch4: debugger lost track of lines in eval
+ * 
  * Revision 4.0.1.1  91/04/11  17:49:05  lwall
  * patch1: fixed undefined environ problem
  * 
@@ -23,6 +32,8 @@ char rcsid[] = "$RCSfile: perl.c,v $$Revision: 4.0.1.1 $$Date: 91/04/11 17:49:05
 #include "patchlevel.h"
 #endif
 
+char *getenv();
+
 #ifdef IAMSUID
 #ifndef DOSUID
 #define DOSUID
@@ -50,7 +61,7 @@ register char **env;
 {
     register STR *str;
     register char *s;
-    char *index(), *strcpy(), *getenv();
+    char *getenv();
     bool dosearch = FALSE;
 #ifdef DOSUID
     char *validarg = "";
@@ -656,7 +667,7 @@ FIX YOUR KERNEL, PUT A C WRAPPER AROUND THIS SCRIPT, OR USE -u AND UNDUMP!\n");
 	(void)hadd(sigstab);
     }
 
-    magicalize("!#?^~=-%.+&*()<>,\\/[|`':\004\t\024\027");
+    magicalize("!#?^~=-%.+&*()<>,\\/[|`':\004\t\020\024\027\006");
     userinit();		/* in case linked C routines want magical variables */
 
     amperstab = stabent("&",allstabs);
@@ -740,7 +751,7 @@ FIX YOUR KERNEL, PUT A C WRAPPER AROUND THIS SCRIPT, OR USE -u AND UNDUMP!\n");
 	str_set(stab_val(tmpstab),origfilename);
 	magicname("0", Nullch, 0);
     }
-    if (tmpstab = stabent("\020",allstabs))
+    if (tmpstab = stabent("\030",allstabs))
 	str_set(stab_val(tmpstab),origargv[0]);
     if (argvstab = stabent("ARGV",allstabs)) {
 	argvstab->str_pok |= SP_MULTI;
@@ -830,6 +841,31 @@ int namlen;
     }
 }
 
+void
+savelines(array, str)
+ARRAY *array;
+STR *str;
+{
+    register char *s = str->str_ptr;
+    register char *send = str->str_ptr + str->str_cur;
+    register char *t;
+    register int line = 1;
+
+    while (s && s < send) {
+	STR *tmpstr = Str_new(85,0);
+
+	t = index(s, '\n');
+	if (t)
+	    t++;
+	else
+	    t = send;
+
+	str_nset(tmpstr, s, t - s);
+	astore(array, line++, tmpstr);
+	s = t;
+    }
+}
+
 /* this routine is in perl.c by virtue of being sort of an alternate main() */
 
 int
@@ -871,7 +907,9 @@ int *arglast;
 	curcmd->c_filestab = fstab("(eval)");
 	curcmd->c_line = 1;
 	str_sset(linestr,str);
-	str_cat(linestr,";");		/* be kind to them */
+	str_cat(linestr,";\n");		/* be kind to them */
+	if (perldb)
+	    savelines(stab_xarray(curcmd->c_filestab), linestr);
     }
     else {
 	if (last_root && !in_eval) {
@@ -1201,6 +1239,9 @@ my_unexec()
 	fprintf(stderr, "unexec of %s into %s failed!\n", perlpath, dumpname);
     exit(status);
 #else
+#ifdef MSDOS
+    abort();	/* nothing else to do */
+#else /* ! MSDOS */
 #   ifndef SIGABRT
 #	define SIGABRT SIGILL
 #   endif
@@ -1208,6 +1249,7 @@ my_unexec()
 #	define SIGILL 6		/* blech */
 #   endif
     kill(getpid(),SIGABRT);	/* for use with undump */
+#endif /* ! MSDOS */
 #endif
 }
 
diff --git a/perl.h b/perl.h
index 96d5d554e7..43737aa6d0 100644
--- a/perl.h
+++ b/perl.h
@@ -1,11 +1,16 @@
-/* $RCSfile: perl.h,v $$Revision: 4.0.1.1 $$Date: 91/04/11 17:49:51 $
+/* $RCSfile: perl.h,v $$Revision: 4.0.1.2 $$Date: 91/06/07 11:28:33 $
  *
- *    Copyright (c) 1989, Larry Wall
+ *    Copyright (c) 1991, Larry Wall
  *
- *    You may distribute under the terms of the GNU General Public License
- *    as specified in the README file that comes with the perl 3.0 kit.
+ *    You may distribute under the terms of either the GNU General Public
+ *    License or the Artistic License, as specified in the README file.
  *
  * $Log:	perl.h,v $
+ * Revision 4.0.1.2  91/06/07  11:28:33  lwall
+ * patch4: new copyright notice
+ * patch4: made some allowances for "semi-standard" C
+ * patch4: many, many itty-bitty portability fixes
+ * 
  * Revision 4.0.1.1  91/04/11  17:49:51  lwall
  * patch1: hopefully straightened out some of the Xenix mess
  * 
@@ -47,7 +52,11 @@
 
 #endif /* !MSDOS */
 
-#if defined(HASVOLATILE) || defined(__STDC__)
+#if defined(__STDC__) || defined(_AIX) || defined(__stdc__)
+# define STANDARD_C 1
+#endif
+
+#if defined(HASVOLATILE) || defined(STANDARD_C)
 #define VOLATILE volatile
 #else
 #define VOLATILE
@@ -81,13 +90,16 @@
 #include <ctype.h>
 #include <setjmp.h>
 #ifndef MSDOS
-#include <sys/param.h>	/* if this needs types.h we're still wrong */
+#ifdef PARAM_NEEDS_TYPES
+#include <sys/types.h>
 #endif
-#ifdef __STDC__
+#include <sys/param.h>
+#endif
+#ifdef STANDARD_C
 /* Use all the "standard" definitions */
 #include <stdlib.h>
 #include <string.h>
-#endif /* __STDC__ */
+#endif /* STANDARD_C */
 
 #if defined(HAS_MEMCMP) && defined(mips) && BYTEORDER == 0x1234
 #undef HAS_MEMCMP
@@ -95,19 +107,25 @@
 
 #ifdef HAS_MEMCPY
 
-#  ifndef __STDC__
+#  ifndef STANDARD_C
 #    ifndef memcpy
 extern char * memcpy(), *memset();
 extern int memcmp();
 #    endif /* ndef memcpy */
-#  endif /* ndef __STDC__ */
+#  endif /* ndef STANDARD_C */
 
-#define bcopy(s1,s2,l) memcpy(s2,s1,l)
-#define bzero(s,l) memset(s,0,l)
+#   ifndef bcopy
+#	define bcopy(s1,s2,l) memcpy(s2,s1,l)
+#   endif
+#   ifndef bzero
+#	define bzero(s,l) memset(s,0,l)
+#   endif
 #endif /* HAS_MEMCPY */
 
 #ifndef HAS_BCMP		/* prefer bcmp slightly 'cuz it doesn't order */
-#define bcmp(s1,s2,l) memcmp(s1,s2,l)
+#   ifndef bcmp
+#	define bcmp(s1,s2,l) memcmp(s1,s2,l)
+#   endif
 #endif
 
 #ifndef _TYPES_		/* If types.h defines this it's easy. */
@@ -245,6 +263,13 @@ EXT int dbmlen;
 #   endif
 #endif
 
+#ifdef FPUTS_BOTCH
+/* work around botch in SunOS 4.0.1 and 4.0.2 */
+#   ifndef fputs
+#	define fputs(str,fp) fprintf(fp,"%s",str)
+#   endif
+#endif
+
 /*
  * The following gobbledygook brought to you on behalf of __STDC__.
  * (I could just use #ifndef __STDC__, but this is more bulletproof
@@ -345,6 +370,10 @@ EXT int dbmlen;
 #   define S_ISGID 02000
 #endif
 
+#ifdef f_next
+#undef f_next
+#endif
+
 typedef unsigned int STRLEN;
 
 typedef struct arg ARG;
@@ -377,7 +406,7 @@ typedef struct callsave CSV;
 #   define I286
 #endif
 
-#ifndef	__STDC__
+#ifndef	STANDARD_C
 #ifdef CHARSPRINTF
     char *sprintf();
 #else
@@ -681,6 +710,11 @@ 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? */
 
+#ifndef MAXSYSFD
+#   define MAXSYSFD 2
+#endif
+EXT int maxsysfd INIT(MAXSYSFD);	/* top fd to pass to subprocesses */
+
 #ifdef CSH
 char *cshname INIT(CSH);
 int cshlen INIT(0);
@@ -790,14 +824,14 @@ EXT short *ds;
 /* Fix these up for __STDC__ */
 EXT long basetime INIT(0);
 char *mktemp();
-#ifndef __STDC__
+#ifndef STANDARD_C
 /* All of these are in stdlib.h or time.h for ANSI C */
 double atof();
 long time();
 struct tm *gmtime(), *localtime();
 char *index(), *rindex();
 char *strcpy(), *strcat();
-#endif /* ! __STDC__ */
+#endif /* ! STANDARD_C */
 
 #ifdef EUNICE
 #define UNLINK unlnk
diff --git a/perl.man b/perl.man
index 7dc7714050..50a5f9b964 100644
--- a/perl.man
+++ b/perl.man
@@ -1,7 +1,14 @@
 .rn '' }`
-''' $RCSfile: perl.man,v $$Revision: 4.0.1.1 $$Date: 91/04/11 17:50:44 $
+''' $RCSfile: perl.man,v $$Revision: 4.0.1.2 $$Date: 91/06/07 11:41:23 $
 ''' 
 ''' $Log:	perl.man,v $
+''' Revision 4.0.1.2  91/06/07  11:41:23  lwall
+''' patch4: added global modifier for pattern matches
+''' patch4: default top-of-form format is now FILEHANDLE_TOP
+''' patch4: added $^P variable to control calling of perldb routines
+''' patch4: added $^F variable to specify maximum system fd, default 2
+''' patch4: changed old $^P to $^X
+''' 
 ''' Revision 4.0.1.1  91/04/11  17:50:44  lwall
 ''' patch1: fixed some typos
 ''' 
@@ -1606,58 +1613,6 @@ Thus, a portable way to find out the home directory might be:
 	    (getpwuid($<))[7] || die "You're homeless!\en";
 
 .fi
-''' Beginning of part 2
-''' $RCSfile: perl.man,v $$Revision: 4.0.1.1 $$Date: 91/04/11 17:50:44 $
-'''
-''' $Log:	perl.man,v $
-''' Revision 4.0.1.1  91/04/11  17:50:44  lwall
-''' patch1: fixed some typos
-''' 
-''' Revision 4.0  91/03/20  01:38:08  lwall
-''' 4.0 baseline.
-''' 
-''' Revision 3.0.1.11  91/01/11  18:17:08  lwall
-''' patch42: fixed some man page entries
-''' 
-''' Revision 3.0.1.10  90/11/10  01:46:29  lwall
-''' patch38: random cleanup
-''' patch38: added alarm function
-''' 
-''' Revision 3.0.1.9  90/10/15  18:17:37  lwall
-''' patch29: added caller
-''' patch29: index and substr now have optional 3rd args
-''' patch29: added SysV IPC
-''' 
-''' Revision 3.0.1.8  90/08/13  22:21:00  lwall
-''' patch28: documented that you can't interpolate $) or $| in pattern
-''' 
-''' Revision 3.0.1.7  90/08/09  04:27:04  lwall
-''' patch19: added require operator
-''' 
-''' Revision 3.0.1.6  90/08/03  11:15:29  lwall
-''' patch19: Intermediate diffs for Randal
-''' 
-''' Revision 3.0.1.5  90/03/27  16:15:17  lwall
-''' patch16: MSDOS support
-''' 
-''' Revision 3.0.1.4  90/03/12  16:46:02  lwall
-''' patch13: documented behavior of @array = /noparens/
-''' 
-''' 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
-''' 
-''' Revision 3.0.1.1  89/11/11  04:43:10  lwall
-''' patch2: made some line breaks depend on troff vs. nroff
-''' patch2: example of unshift had args backwards
-''' 
-''' Revision 3.0  89/10/18  15:21:37  lwall
-''' 3.0 baseline
-''' 
-'''
 .PP
 Along with the literals and variables mentioned earlier,
 the operations in the following section can serve as terms in an expression.
@@ -1796,7 +1751,7 @@ Returns the number of files successfully changed.
 
 .fi
 .ne 23
-Here's an example of looking up non-numeric uids:
+Here's an example that looks up non-numeric uids in the passwd file:
 .nf
 
 	print "User: ";
@@ -2718,8 +2673,8 @@ If EXPR is omitted, returns log of $_.
 Does the same thing as the stat() function, but stats a symbolic link
 instead of the file the symbolic link points to.
 If symbolic links are unimplemented on your system, a normal stat is done.
-.Ip "m/PATTERN/io" 8 4
-.Ip "/PATTERN/io" 8
+.Ip "m/PATTERN/gio" 8 4
+.Ip "/PATTERN/gio" 8
 Searches a string for a pattern match, and returns true (1) or false (\'\').
 If no string is specified via the =~ or !~ operator,
 the $_ string is searched.
@@ -2778,6 +2733,36 @@ This last example splits $foo into the first two words and the remainder
 of the line, and assigns those three fields to $F1, $F2 and $Etc.
 The conditional is true if any variables were assigned, i.e. if the pattern
 matched.
+.Sp
+The \*(L"g\*(R" modifier specifies global pattern matching\*(--that is,
+matching as many times as possible within the string.  How it behaves
+depends on the context.  In an array context, it returns a list of
+all the substrings matched by all the parentheses in the regular expression.
+If there are no parentheses, it returns a list of all the matched strings,
+as if there were parentheses around the whole pattern.  In a scalar context,
+it iterates through the string, returning TRUE each time it matches, and
+FALSE when it eventually runs out of matches.  (In other words, it remembers
+where it left off last time and restarts the search at that point.)  It
+presumes that you have not modified the string since the last match.
+Modifying the string between matches may result in undefined behavior.
+(You can actually get away with in-place modifications via substr()
+that do not change the length of the entire string.  In general, however,
+you should be using s///g for such modifications.)  Examples:
+.nf
+
+	# array context
+	($one,$five,$fifteen) = (\`uptime\` =~ /(\ed+\e.\ed+)/g);
+
+	# scalar context
+	$/ = 1; $* = 1;
+	while ($paragraph = <>) {
+	    while ($paragraph =~ /[a-z][\'")]*[.!?]+[\'")]*\es/g) {
+		$sentences++;
+	    }
+	}
+	print "$sentences\en";
+
+.fi
 .Ip "mkdir(FILENAME,MODE)" 8 3
 Creates the directory specified by FILENAME, with permissions specified by
 MODE (as modified by umask).
@@ -2802,70 +2787,6 @@ SIZE.  Note that if a message is received, the message type will be
 the first thing in VAR, and the maximum length of VAR is SIZE plus the
 size of the message type.  Returns true if successful, or false if
 there is an error.
-''' Beginning of part 3
-''' $RCSfile: perl.man,v $$Revision: 4.0.1.1 $$Date: 91/04/11 17:50:44 $
-'''
-''' $Log:	perl.man,v $
-''' Revision 4.0.1.1  91/04/11  17:50:44  lwall
-''' patch1: fixed some typos
-''' 
-''' Revision 4.0  91/03/20  01:38:08  lwall
-''' 4.0 baseline.
-''' 
-''' Revision 3.0.1.12  91/01/11  18:18:15  lwall
-''' patch42: added binary and hex pack/unpack options
-''' 
-''' Revision 3.0.1.11  90/11/10  01:48:21  lwall
-''' patch38: random cleanup
-''' patch38: documented tr///cds
-''' 
-''' Revision 3.0.1.10  90/10/20  02:15:17  lwall
-''' patch37: patch37: fixed various typos in man page
-''' 
-''' Revision 3.0.1.9  90/10/16  10:02:43  lwall
-''' patch29: you can now read into the middle string
-''' patch29: index and substr now have optional 3rd args
-''' patch29: added scalar reverse
-''' patch29: added scalar
-''' patch29: added SysV IPC
-''' patch29: added waitpid
-''' patch29: added sysread and syswrite
-''' 
-''' Revision 3.0.1.8  90/08/09  04:39:04  lwall
-''' patch19: added require operator
-''' patch19: added truncate operator
-''' patch19: unpack can do checksumming
-''' 
-''' Revision 3.0.1.7  90/08/03  11:15:42  lwall
-''' patch19: Intermediate diffs for Randal
-''' 
-''' Revision 3.0.1.6  90/03/27  16:17:56  lwall
-''' patch16: MSDOS support
-''' 
-''' Revision 3.0.1.5  90/03/12  16:52:21  lwall
-''' patch13: documented that print $filehandle &foo is ambiguous
-''' patch13: added splice operator: @oldelems = splice(@array,$offset,$len,LIST)
-''' 
-''' 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
-''' 
-''' Revision 3.0.1.2  89/11/17  15:31:05  lwall
-''' patch5: fixed some manual typos and indent problems
-''' patch5: added warning about print making an array context
-''' 
-''' Revision 3.0.1.1  89/11/11  04:45:06  lwall
-''' patch2: made some line breaks depend on troff vs. nroff
-''' 
-''' Revision 3.0  89/10/18  15:21:46  lwall
-''' 3.0 baseline
-''' 
 .Ip "next LABEL" 8 8
 .Ip "next" 8
 The
@@ -3661,6 +3582,7 @@ If SUBROUTINE is omitted, sorts in standard string comparison order.
 If SUBROUTINE is specified, gives the name of a subroutine that returns
 an integer less than, equal to, or greater than 0,
 depending on how the elements of the array are to be ordered.
+(The <=> and cmp operators are extremely useful in such routines.)
 In the interests of efficiency the normal calling code for subroutines
 is bypassed, with the following effects: the subroutine may not be a recursive
 subroutine, and the two elements to be compared are passed into the subroutine
@@ -3673,12 +3595,12 @@ Examples:
 
 .ne 4
 	sub byage {
-	    $age{$a} - $age{$b};	# presuming integers
+	    $age{$a} <=> $age{$b};	# presuming integers
 	}
 	@sortedclass = sort byage @class;
 
 .ne 9
-	sub reverse { $a lt $b ? 1 : $a gt $b ? \-1 : 0; }
+	sub reverse { $b cmp $a; }
 	@harry = (\'dog\',\'cat\',\'x\',\'Cain\',\'Abel\');
 	@george = (\'gone\',\'chased\',\'yz\',\'Punished\',\'Axed\');
 	print sort @harry;
@@ -3842,6 +3764,7 @@ Example:
 	}
 
 .fi
+(This only works on machines for which the device number is negative under NFS.)
 .Ip "study(SCALAR)" 8 6
 .Ip "study SCALAR" 8
 .Ip "study"
@@ -4266,65 +4189,6 @@ resulting string is used to look up the name of the FILEHANDLE at run time.
 For more on formats, see the section on formats later on.
 .Sp
 Note that write is NOT the opposite of read.
-''' Beginning of part 4
-''' $RCSfile: perl.man,v $$Revision: 4.0.1.1 $$Date: 91/04/11 17:50:44 $
-'''
-''' $Log:	perl.man,v $
-''' Revision 4.0.1.1  91/04/11  17:50:44  lwall
-''' patch1: fixed some typos
-''' 
-''' Revision 4.0  91/03/20  01:38:08  lwall
-''' 4.0 baseline.
-''' 
-''' Revision 3.0.1.14  91/01/11  18:18:53  lwall
-''' patch42: started an addendum and errata section in the man page
-''' 
-''' Revision 3.0.1.13  90/11/10  01:51:00  lwall
-''' patch38: random cleanup
-''' 
-''' Revision 3.0.1.12  90/10/20  02:15:43  lwall
-''' patch37: patch37: fixed various typos in man page
-''' 
-''' Revision 3.0.1.11  90/10/16  10:04:28  lwall
-''' patch29: added @###.## fields to format
-''' 
-''' Revision 3.0.1.10  90/08/09  04:47:35  lwall
-''' patch19: added require operator
-''' patch19: added numeric interpretation of $]
-''' 
-''' Revision 3.0.1.9  90/08/03  11:15:58  lwall
-''' patch19: Intermediate diffs for Randal
-''' 
-''' Revision 3.0.1.8  90/03/27  16:19:31  lwall
-''' patch16: MSDOS support
-''' 
-''' Revision 3.0.1.7  90/03/14  12:29:50  lwall
-''' patch15: man page falsely states that you can't subscript array values
-''' 
-''' Revision 3.0.1.6  90/03/12  16:54:04  lwall
-''' patch13: improved documentation of *name
-''' 
-''' 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
-''' 
-''' Revision 3.0.1.3  89/11/17  15:32:25  lwall
-''' patch5: fixed some manual typos and indent problems
-''' patch5: clarified difference between $! and $@
-''' 
-''' Revision 3.0.1.2  89/11/11  04:46:40  lwall
-''' patch2: made some line breaks depend on troff vs. nroff
-''' patch2: clarified operation of ^ and $ when $* is false
-''' 
-''' Revision 3.0.1.1  89/10/26  23:18:43  lwall
-''' patch1: documented the desirability of unnecessary parentheses
-''' 
-''' Revision 3.0  89/10/18  15:21:55  lwall
-''' 3.0 baseline
-''' 
 .Sh "Precedence"
 .I Perl
 operators have the following associativity and precedence:
@@ -4736,7 +4600,7 @@ Examples:
 
 .ne 10
 # a report on the /etc/passwd file
-format top =
+format STDOUT_TOP =
 \&                        Passwd File
 Name                Login    Office   Uid   Gid Home
 ------------------------------------------------------------------
@@ -4748,7 +4612,7 @@ $name,              $login,  $office,$uid,$gid, $home
 
 .ne 29
 # a report from a bug report form
-format top =
+format STDOUT_TOP =
 \&                        Bug Reports
 @<<<<<<<<<<<<<<<<<<<<<<<     @|||         @>>>>>>>>>>>>>>>>>>>>>>>
 $system,                      $%,         $date
@@ -4990,10 +4854,12 @@ The number of lines left on the page of the currently selected output channel.
 .Ip $~ 8
 The name of the current report format for the currently selected output
 channel.
+Default is name of the filehandle.
 (Mnemonic: brother to $^.)
 .Ip $^ 8
 The name of the current top-of-page format for the currently selected output
 channel.
+Default is name of the filehandle with \*(L"_TOP\*(R" appended.
 (Mnemonic: points to top of page.)
 .Ip $| 8
 If set to nonzero, forces a flush after every write or print on the currently
@@ -5197,6 +5063,11 @@ The current value of the debugging flags.
 (Mnemonic: value of
 .B \-D
 switch.)
+.Ip $^F 8 2
+The maximum system file descriptor, ordinarily 2.  System file descriptors
+are passed to subprocesses, while higher file descriptors are not.
+During an open, system file descriptors are preserved even if the open
+fails.  Ordinary file descriptors are closed before the open is attempted.
 .Ip $^I 8 2
 The current value of the inplace-edit extension.
 Use undef to disable inplace editing.
@@ -5204,7 +5075,9 @@ Use undef to disable inplace editing.
 .B \-i
 switch.)
 .Ip $^P 8 2
-The name that Perl itself was invoked as, from argv[0].
+The internal flag that the debugger clears so that it doesn't
+debug itself.  You could conceivable disable debugging yourself
+by clearing it.
 .Ip $^T 8 2
 The time at which the script began running, in seconds since the epoch.
 The values returned by the
@@ -5218,6 +5091,8 @@ The current value of the warning switch.
 (Mnemonic: related to the
 .B \-w
 switch.)
+.Ip $^X 8 2
+The name that Perl itself was executed as, from argv[0].
 .Ip $ARGV 8 3
 contains the name of the current file when reading from <>.
 .Ip @ARGV 8 3
diff --git a/t/op/pat.t b/t/op/pat.t
index c770391dce..5223ef0be0 100644
--- a/t/op/pat.t
+++ b/t/op/pat.t
@@ -1,8 +1,8 @@
 #!./perl
 
-# $Header: pat.t,v 4.0 91/03/20 01:54:01 lwall Locked $
+# $RCSfile: pat.t,v $$Revision: 4.0.1.1 $$Date: 91/06/07 12:01:26 $
 
-print "1..43\n";
+print "1..48\n";
 
 $x = "abc\ndef\n";
 
@@ -118,3 +118,59 @@ print /(y{2,3}.)/ ? "ok 40\n" : "not ok 40\n";
 print $1 eq 'yyy ' ? "ok 41\n" : "not ok 41\n";
 print /x {3,4}/ ? "not ok 42\n" : "ok 42\n";
 print /^xxx {3,4}/ ? "not ok 43\n" : "ok 43\n";
+
+$_ = "now is the time for all good men to come to.";
+@words = /(\w+)/g;
+print join(':',@words) eq "now:is:the:time:for:all:good:men:to:come:to"
+    ? "ok 44\n"
+    : "not ok 44\n";
+
+@words = ();
+while (/\w+/g) {
+    push(@words, $&);
+}
+print join(':',@words) eq "now:is:the:time:for:all:good:men:to:come:to"
+    ? "ok 45\n"
+    : "not ok 45\n";
+
+@words = ();
+while (/to/g) {
+    push(@words, $&);
+}
+print join(':',@words) eq "to:to"
+    ? "ok 46\n"
+    : "not ok 46 @words\n";
+
+@words = /to/g;
+print join(':',@words) eq "to:to"
+    ? "ok 47\n"
+    : "not ok 47 @words\n";
+
+$_ = "abcdefghi";
+
+$pat1 = 'def';
+$pat2 = '^def';
+$pat3 = '.def.';
+$pat4 = 'abc';
+$pat5 = '^abc';
+$pat6 = 'abc$';
+$pat7 = 'ghi';
+$pat8 = '\w*ghi';
+$pat9 = 'ghi$';
+
+$t1=$t2=$t3=$t4=$t5=$t6=$t7=$t8=$t9=0;
+
+for $iter (1..5) {
+    $t1++ if /$pat1/o;
+    $t2++ if /$pat2/o;
+    $t3++ if /$pat3/o;
+    $t4++ if /$pat4/o;
+    $t5++ if /$pat5/o;
+    $t6++ if /$pat6/o;
+    $t7++ if /$pat7/o;
+    $t8++ if /$pat8/o;
+    $t9++ if /$pat9/o;
+}
+
+$x = "$t1$t2$t3$t4$t5$t6$t7$t8$t9";
+print $x eq '505550555' ? "ok 48\n" : "not ok 48 $x\n";
diff --git a/x2p/hash.c b/x2p/hash.c
index fd92045bc3..03ff1b2c79 100644
--- a/x2p/hash.c
+++ b/x2p/hash.c
@@ -1,11 +1,14 @@
-/* $Header: hash.c,v 4.0 91/03/20 01:57:49 lwall Locked $
+/* $RCSfile: hash.c,v $$Revision: 4.0.1.1 $$Date: 91/06/07 12:15:55 $
  *
- *    Copyright (c) 1989, Larry Wall
+ *    Copyright (c) 1991, Larry Wall
  *
- *    You may distribute under the terms of the GNU General Public License
- *    as specified in the README file that comes with the perl 3.0 kit.
+ *    You may distribute under the terms of either the GNU General Public
+ *    License or the Artistic License, as specified in the README file.
  *
  * $Log:	hash.c,v $
+ * Revision 4.0.1.1  91/06/07  12:15:55  lwall
+ * patch4: new copyright notice
+ * 
  * Revision 4.0  91/03/20  01:57:49  lwall
  * 4.0 baseline.
  * 
diff --git a/x2p/hash.h b/x2p/hash.h
index 14d2069362..bd65b8dbac 100644
--- a/x2p/hash.h
+++ b/x2p/hash.h
@@ -1,11 +1,14 @@
-/* $Header: hash.h,v 4.0 91/03/20 01:57:53 lwall Locked $
+/* $RCSfile: hash.h,v $$Revision: 4.0.1.1 $$Date: 91/06/07 12:16:04 $
  *
- *    Copyright (c) 1989, Larry Wall
+ *    Copyright (c) 1991, Larry Wall
  *
- *    You may distribute under the terms of the GNU General Public License
- *    as specified in the README file that comes with the perl 3.0 kit.
+ *    You may distribute under the terms of either the GNU General Public
+ *    License or the Artistic License, as specified in the README file.
  *
  * $Log:	hash.h,v $
+ * Revision 4.0.1.1  91/06/07  12:16:04  lwall
+ * patch4: new copyright notice
+ * 
  * Revision 4.0  91/03/20  01:57:53  lwall
  * 4.0 baseline.
  *