perl 4.0 patch 31: patch #20, continued

See patch #20.

17 files changed, 354 insertions, 126 deletions

diff --git a/atarist/test/sig b/atarist/test/sig
new file mode 100644
index 0000000000..ac1b2b2fee
--- /dev/null
+++ b/atarist/test/sig
@@ -0,0 +1,12 @@
+sub handler {
+    local($sig) = @_;
+    print "Caught SIG$sig\n";
+    exit(0);
+}
+
+$SIG{'INT'} = 'handler';
+
+print "Hit CRTL-C to see if it is trapped\n";
+while($_ = <ARGV>) {
+    print $_;
+}
diff --git a/atarist/test/tbinmode b/atarist/test/tbinmode
new file mode 100644
index 0000000000..4cf4f7827f
--- /dev/null
+++ b/atarist/test/tbinmode
@@ -0,0 +1,12 @@
+open(FP, ">bintest") || die "Can't open bintest for write\n";
+binmode FP;
+print FP pack("C*", 0xaa, 0x55, 0xaa, 0x55,
+                    0xff, 0x0d, 0x0a);
+close FP;
+
+open(FP, "<bintest") || die "Can't open bintest for read\n";
+binmode FP;
+@got = unpack("C*", <FP>);
+close FP;
+printf "expect:\t7 elements: aa 55 aa 55 ff 0d 0a\n";
+printf "got:\t%d elements: %x %x %x %x %x %02x %02x\n", $#got+1-$[, @got;
diff --git a/atarist/usersub.c b/atarist/usersub.c
new file mode 100644
index 0000000000..aba53d7903
--- /dev/null
+++ b/atarist/usersub.c
@@ -0,0 +1,9 @@
+#include "EXTERN.h"
+#include "perl.h"
+#include <stdio.h>
+
+int userinit()
+{
+    install_null();	/* install device /dev/null or NUL: */
+    return 0;
+}
diff --git a/hints/sco_2_3_3.sh b/hints/sco_2_3_3.sh
index d1db39f8af..10baafd6a3 100644
--- a/hints/sco_2_3_3.sh
+++ b/hints/sco_2_3_3.sh
@@ -1,4 +1,3 @@
 yacc='/usr/bin/yacc -Sm25000'
-libswanted=`echo $libswanted | sed 's/ x / /'`
 echo "NOTE: you may have problems due to a spurious semicolon on the strerror()"
 echo "macro definition in /usr/include/string.h.  If so, delete the semicolon."
diff --git a/hints/sco_2_3_4.sh b/hints/sco_2_3_4.sh
new file mode 100644
index 0000000000..3a1b13c1b6
--- /dev/null
+++ b/hints/sco_2_3_4.sh
@@ -0,0 +1,5 @@
+yacc='/usr/bin/yacc -Sm25000'
+ccflags="$ccflags -UM_I86"
+d_mymalloc=define
+echo "NOTE: you may have problems due to a spurious semicolon on the strerror()"
+echo "macro definition in /usr/include/string.h.  If so, delete the semicolon."
diff --git a/hints/sgi.sh b/hints/sgi.sh
index b7db156461..4252aaf148 100644
--- a/hints/sgi.sh
+++ b/hints/sgi.sh
@@ -1,6 +1,12 @@
 optimize='-O1'
-usemymalloc='y'
+d_mymalloc=define
 mallocsrc='malloc.c'
 mallocobj='malloc.o'
 d_voidsig=define
 d_vfork=undef
+d_charsprf=undef
+case `(uname -r) 2>/dev/null` in
+4*)libswanted=`echo $libswanted | sed 's/c_s \(.*\)/\1 c_s/'`
+    ccflags="$ccflags -DLANGUAGE_C -DBSD_SIGNALS -cckr -signed"
+    ;;
+esac
diff --git a/hints/ultrix_4.sh b/hints/ultrix_4.sh
index 91e5d7d109..633e904b72 100644
--- a/hints/ultrix_4.sh
+++ b/hints/ultrix_4.sh
@@ -18,5 +18,6 @@ case "$tmp" in
     toke_cflags='optimize="-g"'
     ttoke_cflags='optimize="-g"'
     ;;
+*4.2*) libswanted=`echo $libswanted | sed 's/ malloc / /'` ;;
 esac
 
diff --git a/hints/unisysdynix.sh b/hints/unisysdynix.sh
new file mode 100644
index 0000000000..4251ba8d47
--- /dev/null
+++ b/hints/unisysdynix.sh
@@ -0,0 +1 @@
+d_waitpid=undef
diff --git a/lib/shellwords.pl b/lib/shellwords.pl
index 168991fa3f..5d593daa50 100644
--- a/lib/shellwords.pl
+++ b/lib/shellwords.pl
@@ -1,12 +1,12 @@
-#; shellwords.pl
-#;
-#; Usage:
-#;	require 'shellwords.pl';
-#;	@words = &shellwords($line);
-#;	or
-#;	@words = &shellwords(@lines);
-#;	or
-#;	@words = &shellwords;		# defaults to $_ (and clobbers it)
+;# shellwords.pl
+;#
+;# Usage:
+;#	require 'shellwords.pl';
+;#	@words = &shellwords($line);
+;#	or
+;#	@words = &shellwords(@lines);
+;#	or
+;#	@words = &shellwords;		# defaults to $_ (and clobbers it)
 
 sub shellwords {
     package shellwords;
@@ -17,12 +17,18 @@ sub shellwords {
     while ($_ ne '') {
 	$field = '';
 	for (;;) {
-	    if (s/^"(([^"\\]+|\\[\\"])*)"//) {
+	    if (s/^"(([^"\\]|\\[\\"])*)"//) {
 		($snippet = $1) =~ s#\\(.)#$1#g;
 	    }
-	    elsif (s/^'(([^'\\]+|\\[\\'])*)'//) {
+	    elsif (/^"/) {
+		die "Unmatched double quote: $_\n";
+	    }
+	    elsif (s/^'(([^'\\]|\\[\\'])*)'//) {
 		($snippet = $1) =~ s#\\(.)#$1#g;
 	    }
+	    elsif (/^'/) {
+		die "Unmatched single quote: $_\n";
+	    }
 	    elsif (s/^\\(.)//) {
 		$snippet = $1;
 	    }
diff --git a/lib/syslog.pl b/lib/syslog.pl
index d5f9812684..842414e4c7 100644
--- a/lib/syslog.pl
+++ b/lib/syslog.pl
@@ -2,6 +2,9 @@
 # syslog.pl
 #
 # $Log:	syslog.pl,v $
+# Revision 4.0.1.1  92/06/08  13:48:05  lwall
+# patch20: new warning for ambiguous use of unary operators
+# 
 # Revision 4.0  91/03/20  01:26:24  lwall
 # 4.0 baseline.
 # 
@@ -164,7 +167,7 @@ sub xlate {
     $name =~ y/a-z/A-Z/;
     $name = "LOG_$name" unless $name =~ /^LOG_/;
     $name = "syslog'$name";
-    eval &$name || -1;
+    eval(&$name) || -1;
 }
 
 sub connect {
diff --git a/patchlevel.h b/patchlevel.h
index 256548d46a..dd91c28f63 100644
--- a/patchlevel.h
+++ b/patchlevel.h
@@ -1 +1 @@
-#define PATCHLEVEL 30
+#define PATCHLEVEL 31
diff --git a/regcomp.c b/regcomp.c
index fd8d42230a..fa072609d5 100644
--- a/regcomp.c
+++ b/regcomp.c
@@ -7,9 +7,15 @@
  * blame Henry for some of the lack of readability.
  */
 
-/* $RCSfile: regcomp.c,v $$Revision: 4.0.1.4 $$Date: 91/11/05 22:55:14 $
+/* $RCSfile: regcomp.c,v $$Revision: 4.0.1.5 $$Date: 92/06/08 15:23:36 $
  *
  * $Log:	regcomp.c,v $
+ * Revision 4.0.1.5  92/06/08  15:23:36  lwall
+ * patch20: Perl now distinguishes overlapped copies from non-overlapped
+ * patch20: /^stuff/ wrongly assumed an implicit $* == 1
+ * patch20: /x{0}/ was wrongly interpreted as /x{0,}/
+ * patch20: added \W, \S and \D inside /[...]/
+ * 
  * Revision 4.0.1.4  91/11/05  22:55:14  lwall
  * patch11: Erratum
  * 
@@ -86,7 +92,11 @@
 #define	ISMULT1(c)	((c) == '*' || (c) == '+' || (c) == '?')
 #define	ISMULT2(s)	((*s) == '*' || (*s) == '+' || (*s) == '?' || \
 	((*s) == '{' && regcurly(s)))
+#ifdef atarist
+#define	PERL_META	"^$.[()|?+*\\"
+#else
 #define	META	"^$.[()|?+*\\"
+#endif
 
 #ifdef SPSTART
 #undef SPSTART		/* dratted cpp namespace... */
@@ -160,10 +170,6 @@ int fold;
 	int backest;
 	int curback;
 	int minlen;
-#ifndef safemalloc
-	extern char *safemalloc();
-#endif
-	extern char *savestr();
 	int sawplus = 0;
 	int sawopen = 0;
 
@@ -198,7 +204,7 @@ int fold;
 
 	/* Second pass: emit code. */
 	if (regsawbracket)
-	    bcopy(regprecomp,exp,xend-exp);
+	    Copy(regprecomp,exp,xend-exp,char);
 	r->prelen = xend-exp;
 	r->precomp = regprecomp;
 	r->subbeg = r->subbase = NULL;
@@ -243,9 +249,14 @@ int fold;
 			r->regstclass = first;
 		else if (OP(first) == BOUND || OP(first) == NBOUND)
 			r->regstclass = first;
-		else if (OP(first) == BOL ||
-		    (OP(first) == STAR && OP(NEXTOPER(first)) == ANY) ) {
-			/* kinda turn .* into ^.* */
+		else if (OP(first) == BOL) {
+			r->reganch = ROPT_ANCH;
+			first = NEXTOPER(first);
+		    	goto again;
+		}
+		else if ((OP(first) == STAR && OP(NEXTOPER(first)) == ANY) &&
+			 !(r->reganch & ROPT_ANCH) ) {
+			/* turn .* into ^.* with an implied $*=1 */
 			r->reganch = ROPT_ANCH | ROPT_IMPLICIT;
 			first = NEXTOPER(first);
 		    	goto again;
@@ -564,6 +575,8 @@ int *flagp;
 		    else
 			max = regparse;
 		    tmp = atoi(max);
+		    if (!tmp && *max != '0')
+			tmp = 32767;		/* meaning "infinity" */
 		    if (tmp && tmp < iter)
 			fatal("Can't do {n,m} with n > m");
 		    if (regcode != &regdummy) {
@@ -967,21 +980,27 @@ regclass()
 			class = UCHARAT(regparse++);
 			switch (class) {
 			case 'w':
-				for (class = 'a'; class <= 'z'; class++)
-					regset(bits,def,class);
-				for (class = 'A'; class <= 'Z'; class++)
+				for (class = 0; class < 256; class++)
+				    if (isALNUM(class))
 					regset(bits,def,class);
-				for (class = '0'; class <= '9'; class++)
+				lastclass = 1234;
+				continue;
+			case 'W':
+				for (class = 0; class < 256; class++)
+				    if (!isALNUM(class))
 					regset(bits,def,class);
-				regset(bits,def,'_');
 				lastclass = 1234;
 				continue;
 			case 's':
-				regset(bits,def,' ');
-				regset(bits,def,'\t');
-				regset(bits,def,'\r');
-				regset(bits,def,'\f');
-				regset(bits,def,'\n');
+				for (class = 0; class < 256; class++)
+				    if (isSPACE(class))
+					regset(bits,def,class);
+				lastclass = 1234;
+				continue;
+			case 'S':
+				for (class = 0; class < 256; class++)
+				    if (!isSPACE(class))
+					regset(bits,def,class);
 				lastclass = 1234;
 				continue;
 			case 'd':
@@ -989,6 +1008,13 @@ regclass()
 					regset(bits,def,class);
 				lastclass = 1234;
 				continue;
+			case 'D':
+				for (class = 0; class < '0'; class++)
+					regset(bits,def,class);
+				for (class = '9' + 1; class < 256; class++)
+					regset(bits,def,class);
+				lastclass = 1234;
+				continue;
 			case 'n':
 				class = '\n';
 				break;
@@ -1184,6 +1210,9 @@ char *opnd;
 	*place++ = '\0';
 	while (offset-- > 0)
 	    *place++ = '\0';
+#ifdef REGALIGN
+	*place++ = '\177';
+#endif
 }
 
 /*
@@ -1420,6 +1449,7 @@ char *op;
 }
 #endif /* DEBUGGING */
 
+void
 regfree(r)
 struct regexp *r;
 {
diff --git a/regexec.c b/regexec.c
index 226aab4b11..d3cef20030 100644
--- a/regexec.c
+++ b/regexec.c
@@ -7,9 +7,14 @@
  * blame Henry for some of the lack of readability.
  */
 
-/* $RCSfile: regexec.c,v $$Revision: 4.0.1.3 $$Date: 91/11/05 18:23:55 $
+/* $RCSfile: regexec.c,v $$Revision: 4.0.1.4 $$Date: 92/06/08 15:25:50 $
  *
  * $Log:	regexec.c,v $
+ * Revision 4.0.1.4  92/06/08  15:25:50  lwall
+ * patch20: pattern modifiers i and g didn't interact right
+ * patch20: in some cases $` and $' didn't get set by match
+ * patch20: /x{0}/ was wrongly interpreted as /x{0,}/
+ * 
  * Revision 4.0.1.3  91/11/05  18:23:55  lwall
  * patch11: prepared for ctype implementations that don't define isascii()
  * patch11: initial .* in pattern had dependency on value of $*
@@ -140,10 +145,9 @@ int safebase;	/* no need to remember string in subbase */
 	}
 
 	if (prog->do_folding) {
-		safebase = FALSE;
 		i = strend - string;
 		New(1101,c,i+1,char);
-		(void)bcopy(string, c, i+1);
+		Copy(string, c, i+1, char);
 		string = c;
 		strend = string + i;
 		for (s = string; s < strend; s++)
@@ -441,6 +445,8 @@ int safebase;	/* no need to remember string in subbase */
 	goto phooey;
 
     got_it:
+	prog->subbeg = strbeg;
+	prog->subend = strend;
 	if ((!safebase && (prog->nparens || sawampersand)) || prog->do_folding){
 		strend += dontbother;	/* uncheat */
 		if (safebase)			/* no need for $digit later */
@@ -453,8 +459,11 @@ int safebase;	/* no need to remember string in subbase */
 		    prog->subbeg = prog->subbase = s;
 		    prog->subend = s+i;
 		}
-		else
-		    s = prog->subbase;
+		else {
+		    i = strend - string + (stringarg - strbeg);
+		    prog->subbeg = s = prog->subbase;
+		    prog->subend = s+i;
+		}
 		s += (stringarg - strbeg);
 		for (i = 0; i <= prog->nparens; i++) {
 			if (prog->endp[i]) {
@@ -742,7 +751,7 @@ char *prog;
 			goto repeat;
 		case STAR:
 			ln = 0;
-			n = 0;
+			n = 32767;
 			scan = NEXTOPER(scan);
 			goto repeat;
 		case PLUS:
@@ -751,7 +760,7 @@ char *prog;
 			 * when we know what character comes next.
 			 */
 			ln = 1;
-			n = 0;
+			n = 32767;
 			scan = NEXTOPER(scan);
 		    repeat:
 			if (OP(next) == EXACTLY)
@@ -813,7 +822,7 @@ int max;
 	register char *loceol = regeol;
 
 	scan = reginput;
-	if (max && max < loceol - scan)
+	if (max != 32767 && max < loceol - scan)
 	    loceol = scan + max;
 	opnd = OPERAND(p);
 	switch (OP(p)) {
diff --git a/stab.c b/stab.c
index d141da3296..f8e6f07d12 100644
--- a/stab.c
+++ b/stab.c
@@ -1,4 +1,4 @@
-/* $RCSfile: stab.c,v $$Revision: 4.0.1.3 $$Date: 91/11/05 18:35:33 $
+/* $RCSfile: stab.c,v $$Revision: 4.0.1.4 $$Date: 92/06/08 15:32:19 $
  *
  *    Copyright (c) 1991, Larry Wall
  *
@@ -6,6 +6,13 @@
  *    License or the Artistic License, as specified in the README file.
  *
  * $Log:	stab.c,v $
+ * Revision 4.0.1.4  92/06/08  15:32:19  lwall
+ * patch20: fixed confusion between a *var's real name and its effective name
+ * patch20: the debugger now warns you on lines that can't set a breakpoint
+ * patch20: the debugger made perl forget the last pattern used by //
+ * patch20: paragraph mode now skips extra newlines automatically
+ * patch20: ($<,$>) = ... didn't work on some architectures
+ * 
  * Revision 4.0.1.3  91/11/05  18:35:33  lwall
  * patch11: length($x) was sometimes wrong for numeric $x
  * patch11: perl now issues warning if $SIG{'ALARM'} is referenced
@@ -91,7 +98,7 @@ STR *str;
     case '1': case '2': case '3': case '4':
     case '5': case '6': case '7': case '8': case '9': case '&':
 	if (curspat) {
-	    paren = atoi(stab_name(stab));
+	    paren = atoi(stab_ename(stab));
 	  getparen:
 	    if (curspat->spat_regexp &&
 	      paren <= curspat->spat_regexp->nparens &&
@@ -138,7 +145,7 @@ STR *str;
 	break;
     case '.':
 #ifndef lint
-	if (last_in_stab) {
+	if (last_in_stab && stab_io(last_in_stab)) {
 	    str_numset(stab_val(stab),(double)stab_io(last_in_stab)->lines);
 	}
 #endif
@@ -151,14 +158,14 @@ STR *str;
 	if (s)
 	    str_set(stab_val(stab),s);
 	else {
-	    str_set(stab_val(stab),stab_name(curoutstab));
+	    str_set(stab_val(stab),stab_ename(curoutstab));
 	    str_cat(stab_val(stab),"_TOP");
 	}
 	break;
     case '~':
 	s = stab_io(curoutstab)->fmt_name;
 	if (!s)
-	    s = stab_name(curoutstab);
+	    s = stab_ename(curoutstab);
 	str_set(stab_val(stab),s);
 	break;
 #ifndef lint
@@ -172,6 +179,8 @@ STR *str;
 	str_numset(stab_val(stab),(double)stab_io(curoutstab)->page);
 	break;
 #endif
+    case ':':
+	break;
     case '/':
 	break;
     case '[':
@@ -260,7 +269,7 @@ STR *str;
     case '1': case '2': case '3': case '4':
     case '5': case '6': case '7': case '8': case '9': case '&':
 	if (curspat) {
-	    paren = atoi(stab_name(stab));
+	    paren = atoi(stab_ename(stab));
 	  getparen:
 	    if (curspat->spat_regexp &&
 	      paren <= curspat->spat_regexp->nparens &&
@@ -314,6 +323,7 @@ STR *str;
     }
 }
 
+void
 stabset(mstr,str)
 register STR *mstr;
 STR *str;
@@ -324,7 +334,7 @@ STR *str;
 
     switch (mstr->str_rare) {
     case 'E':
-	setenv(mstr->str_ptr,str_get(str));
+	my_setenv(mstr->str_ptr,str_get(str));
 				/* And you'll never guess what the dog had */
 				/*   in its mouth... */
 #ifdef TAINT
@@ -376,9 +386,12 @@ STR *str;
 	    stab = mstr->str_u.str_stab;
 	    i = str_true(str);
 	    str = afetch(stab_xarray(stab),atoi(mstr->str_ptr), FALSE);
-	    cmd = str->str_magic->str_u.str_cmd;
-	    cmd->c_flags &= ~CF_OPTIMIZE;
-	    cmd->c_flags |= i? CFT_D1 : CFT_D0;
+	    if (str->str_magic && (cmd = str->str_magic->str_u.str_cmd)) {
+		cmd->c_flags &= ~CF_OPTIMIZE;
+		cmd->c_flags |= i? CFT_D1 : CFT_D0;
+	    }
+	    else
+		warn("Can't break at that line\n");
 	}
 	break;
     case '#':
@@ -405,7 +418,7 @@ STR *str;
 		strcpy(stab_magic(stab),"StB");
 		stab_val(stab) = Str_new(70,0);
 		stab_line(stab) = curcmd->c_line;
-		stab_stash(stab) = curcmd->c_stash;
+		stab_estab(stab) = stab;
 	    }
 	    else {
 		stab = stabent(s,TRUE);
@@ -459,10 +472,19 @@ STR *str;
 		inplace = Nullch;
 	    break;
 	case '\020':	/* ^P */
-	    perldb = (int)str_gnum(str);
+	    i = (int)str_gnum(str);
+	    if (i != perldb) {
+		static SPAT *oldlastspat;
+
+		if (perldb)
+		    oldlastspat = lastspat;
+		else
+		    lastspat = oldlastspat;
+	    }
+	    perldb = i;
 	    break;
 	case '\024':	/* ^T */
-	    basetime = (long)str_gnum(str);
+	    basetime = (time_t)str_gnum(str);
 	    break;
 	case '\027':	/* ^W */
 	    dowarn = (bool)str_gnum(str);
@@ -508,7 +530,7 @@ STR *str;
 	    if (str->str_pok) {
 		rs = str_get(str);
 		rslen = str->str_cur;
-		if (!rslen) {
+		if (rspara = !rslen) {
 		    rs = "\n\n";
 		    rslen = 2;
 		}
@@ -547,42 +569,35 @@ STR *str;
 	    break;
 	case '<':
 	    uid = (int)str_gnum(str);
-#if defined(HAS_SETREUID) || !defined(HAS_SETRUID)
 	    if (delaymagic) {
-		delaymagic |= DM_REUID;
+		delaymagic |= DM_RUID;
 		break;				/* don't do magic till later */
 	    }
-#endif /* HAS_SETREUID or not HASSETRUID */
 #ifdef HAS_SETRUID
-	    if (setruid((UIDTYPE)uid) < 0)
-		uid = (int)getuid();
+	    (void)setruid((UIDTYPE)uid);
 #else
 #ifdef HAS_SETREUID
-	    if (setreuid((UIDTYPE)uid, (UIDTYPE)-1) < 0)
-		uid = (int)getuid();
+	    (void)setreuid((UIDTYPE)uid, (UIDTYPE)-1);
 #else
 	    if (uid == euid)		/* special case $< = $> */
-		setuid(uid);
+		(void)setuid(uid);
 	    else
 		fatal("setruid() not implemented");
 #endif
 #endif
+	    uid = (int)getuid();
 	    break;
 	case '>':
 	    euid = (int)str_gnum(str);
-#if defined(HAS_SETREUID) || !defined(HAS_SETEUID)
 	    if (delaymagic) {
-		delaymagic |= DM_REUID;
+		delaymagic |= DM_EUID;
 		break;				/* don't do magic till later */
 	    }
-#endif /* HAS_SETREUID or not HAS_SETEUID */
 #ifdef HAS_SETEUID
-	    if (seteuid((UIDTYPE)euid) < 0)
-		euid = (int)geteuid();
+	    (void)seteuid((UIDTYPE)euid);
 #else
 #ifdef HAS_SETREUID
-	    if (setreuid((UIDTYPE)-1, (UIDTYPE)euid) < 0)
-		euid = (int)geteuid();
+	    (void)setreuid((UIDTYPE)-1, (UIDTYPE)euid);
 #else
 	    if (euid == uid)		/* special case $> = $< */
 		setuid(euid);
@@ -590,42 +605,47 @@ STR *str;
 		fatal("seteuid() not implemented");
 #endif
 #endif
+	    euid = (int)geteuid();
 	    break;
 	case '(':
 	    gid = (int)str_gnum(str);
-#if defined(HAS_SETREGID) || !defined(HAS_SETRGID)
 	    if (delaymagic) {
-		delaymagic |= DM_REGID;
+		delaymagic |= DM_RGID;
 		break;				/* don't do magic till later */
 	    }
-#endif /* HAS_SETREGID or not HAS_SETRGID */
 #ifdef HAS_SETRGID
 	    (void)setrgid((GIDTYPE)gid);
 #else
 #ifdef HAS_SETREGID
 	    (void)setregid((GIDTYPE)gid, (GIDTYPE)-1);
 #else
-	    fatal("setrgid() not implemented");
+	    if (gid == egid)			/* special case $( = $) */
+		(void)setgid(gid);
+	    else
+		fatal("setrgid() not implemented");
 #endif
 #endif
+	    gid = (int)getgid();
 	    break;
 	case ')':
 	    egid = (int)str_gnum(str);
-#if defined(HAS_SETREGID) || !defined(HAS_SETEGID)
 	    if (delaymagic) {
-		delaymagic |= DM_REGID;
+		delaymagic |= DM_EGID;
 		break;				/* don't do magic till later */
 	    }
-#endif /* HAS_SETREGID or not HAS_SETEGID */
 #ifdef HAS_SETEGID
 	    (void)setegid((GIDTYPE)egid);
 #else
 #ifdef HAS_SETREGID
 	    (void)setregid((GIDTYPE)-1, (GIDTYPE)egid);
 #else
-	    fatal("setegid() not implemented");
+	    if (egid == gid)			/* special case $) = $( */
+		(void)setgid(egid);
+	    else
+		fatal("setegid() not implemented");
 #endif
 #endif
+	    egid = (int)getegid();
 	    break;
 	case ':':
 	    chopset = str_get(str);
@@ -640,7 +660,8 @@ STR *str;
 			s += strlen(++s);	/* this one is ok too */
 		}
 		if (origenviron[0] == s + 1) {	/* can grab env area too? */
-		    setenv("NoNeSuCh", Nullch);	/* force copy of environment */
+		    my_setenv("NoNeSuCh", Nullch);
+						/* force copy of environment */
 		    for (i = 0; origenviron[i]; i++)
 			if (origenviron[i] == s + 1)
 			    s += strlen(++s);
@@ -653,10 +674,10 @@ STR *str;
 		i = origalen;
 		str->str_cur = i;
 		str->str_ptr[i] = '\0';
-		bcopy(s, origargv[0], i);
+		Copy(s, origargv[0], i, char);
 	    }
 	    else {
-		bcopy(s, origargv[0], i);
+		Copy(s, origargv[0], i, char);
 		s = origargv[0]+i;
 		*s++ = '\0';
 		while (++i < origalen)
@@ -676,6 +697,7 @@ STR *str;
     }
 }
 
+int
 whichsig(sig)
 char *sig;
 {
@@ -725,7 +747,7 @@ int sig;
     if (!sub) {
 	if (dowarn)
 	    warn("SIG%s handler \"%s\" not defined.\n",
-		sig_name[sig], stab_name(stab) );
+		sig_name[sig], stab_ename(stab) );
 	return;
     }
     /*SUPPRESS 701*/
@@ -751,7 +773,7 @@ int sig;
     sub->depth++;
     if (sub->depth >= 2) {	/* save temporaries on recursion? */
 	if (sub->depth == 100 && dowarn)
-	    warn("Deep recursion on subroutine \"%s\"",stab_name(stab));
+	    warn("Deep recursion on subroutine \"%s\"",stab_ename(stab));
 	savelist(sub->tosave->ary_array,sub->tosave->ary_fill);
     }
 
@@ -888,6 +910,7 @@ int add;
 	strcpy(stab_magic(stab),"StB");
 	stab_val(stab) = Str_new(72,0);
 	stab_line(stab) = curcmd->c_line;
+	stab_estab(stab) = stab;
 	str_magic((STR*)stab, stab, '*', name, len);
 	stab_stash(stab) = stash;
 	if (isDIGIT(*name) && *name != '0') {
@@ -900,6 +923,7 @@ int add;
     }
 }
 
+void
 stab_fullname(str,stab)
 STR *str;
 STAB *stab;
@@ -913,6 +937,20 @@ STAB *stab;
     str_scat(str,stab->str_magic);
 }
 
+void
+stab_efullname(str,stab)
+STR *str;
+STAB *stab;
+{
+    HASH *tb = stab_estash(stab);
+
+    if (!tb)
+	return;
+    str_set(str,tb->tbl_name);
+    str_ncat(str,"'", 1);
+    str_scat(str,stab_estab(stab)->str_magic);
+}
+
 STIO *
 stio_new()
 {
@@ -923,6 +961,7 @@ stio_new()
     return stio;
 }
 
+void
 stab_check(min,max)
 int min;
 register int max;
@@ -960,6 +999,8 @@ register STAB *stab;
     STIO *stio;
     SUBR *sub;
 
+    if (!stab || !stab->str_ptr)
+	return;
     afree(stab_xarray(stab));
     stab_xarray(stab) = Null(ARRAY*);
     (void)hfree(stab_xhash(stab), FALSE);
diff --git a/stab.h b/stab.h
index 3025342d27..499a2a2ddc 100644
--- a/stab.h
+++ b/stab.h
@@ -1,4 +1,4 @@
-/* $RCSfile: stab.h,v $$Revision: 4.0.1.2 $$Date: 91/11/05 18:36:15 $
+/* $RCSfile: stab.h,v $$Revision: 4.0.1.3 $$Date: 92/06/08 15:33:44 $
  *
  *    Copyright (c) 1991, Larry Wall
  *
@@ -6,6 +6,10 @@
  *    License or the Artistic License, as specified in the README file.
  *
  * $Log:	stab.h,v $
+ * Revision 4.0.1.3  92/06/08  15:33:44  lwall
+ * patch20: fixed confusion between a *var's real name and its effective name
+ * patch20: ($<,$>) = ... didn't work on some architectures
+ * 
  * Revision 4.0.1.2  91/11/05  18:36:15  lwall
  * patch11: length($x) was sometimes wrong for numeric $x
  * 
@@ -25,7 +29,7 @@ struct stabptrs {
     FCMD	*stbp_form;	/* format value */
     ARRAY	*stbp_array;	/* array value */
     HASH	*stbp_hash;	/* associative array value */
-    HASH	*stbp_stash;	/* symbol table for this stab */
+    STAB	*stbp_stab;	/* effective stab, if *glob */
     SUBR	*stbp_sub;	/* subroutine value */
     int		stbp_lastexpr;	/* used by nothing_in_common() */
     line_t	stbp_line;	/* line first declared at (for -w) */
@@ -56,12 +60,19 @@ HASH *stab_hash();
 				 ((STBP*)(stab->str_ptr))->stbp_hash : \
 				 ((STBP*)(hadd(stab)->str_ptr))->stbp_hash)
 #endif			/* Microport 2.4 hack */
-#define stab_stash(stab)	(((STBP*)(stab->str_ptr))->stbp_stash)
 #define stab_sub(stab)		(((STBP*)(stab->str_ptr))->stbp_sub)
 #define stab_lastexpr(stab)	(((STBP*)(stab->str_ptr))->stbp_lastexpr)
 #define stab_line(stab)		(((STBP*)(stab->str_ptr))->stbp_line)
 #define stab_flags(stab)	(((STBP*)(stab->str_ptr))->stbp_flags)
+
+#define stab_stab(stab)		(stab->str_magic->str_u.str_stab)
+#define stab_estab(stab)	(((STBP*)(stab->str_ptr))->stbp_stab)
+
 #define stab_name(stab)		(stab->str_magic->str_ptr)
+#define stab_ename(stab)	stab_name(stab_estab(stab))
+
+#define stab_stash(stab)	(stab->str_magic->str_u.str_stash)
+#define stab_estash(stab)	stab_stash(stab_estab(stab))
 
 #define SF_VMAGIC 1		/* call routine to dereference STR val */
 #define SF_MULTI 2		/* seen more than once */
@@ -114,10 +125,18 @@ EXT STAB *stab_index[128];
 EXT unsigned short statusvalue;
 
 EXT int delaymagic INIT(0);
-#define DM_DELAY 1
-#define DM_REUID 2
-#define DM_REGID 4
+#define DM_UID   0x003
+#define DM_RUID   0x001
+#define DM_EUID   0x002
+#define DM_GID   0x030
+#define DM_RGID   0x010
+#define DM_EGID   0x020
+#define DM_DELAY 0x100
 
 STAB *aadd();
 STAB *hadd();
 STAB *fstab();
+void stabset();
+void stab_fullname();
+void stab_efullname();
+void stab_check();
diff --git a/str.c b/str.c
index 4fdc0630c6..1c0c00e915 100644
--- a/str.c
+++ b/str.c
@@ -1,4 +1,4 @@
-/* $RCSfile: str.c,v $$Revision: 4.0.1.4 $$Date: 91/11/05 18:40:51 $
+/* $RCSfile: str.c,v $$Revision: 4.0.1.5 $$Date: 92/06/08 15:40:43 $
  *
  *    Copyright (c) 1991, Larry Wall
  *
@@ -6,6 +6,16 @@
  *    License or the Artistic License, as specified in the README file.
  *
  * $Log:	str.c,v $
+ * Revision 4.0.1.5  92/06/08  15:40:43  lwall
+ * patch20: removed implicit int declarations on functions
+ * patch20: Perl now distinguishes overlapped copies from non-overlapped
+ * patch20: paragraph mode now skips extra newlines automatically
+ * patch20: fixed memory leak in doube-quote interpretation
+ * patch20: made /\$$foo/ look for literal '$foo'
+ * patch20: "$var{$foo'bar}" didn't scan subscript correctly
+ * patch20: a splice on non-existent array elements could dump core
+ * patch20: running taintperl explicitly now does checks even if $< == $>
+ * 
  * Revision 4.0.1.4  91/11/05  18:40:51  lwall
  * patch11: $foo .= <BAR> could overrun malloced memory
  * patch11: \$ didn't always make it through double-quoter to regexp routines
@@ -32,6 +42,9 @@
 #include "perl.h"
 #include "perly.h"
 
+static void ucase();
+static void lcase();
+
 #ifndef str_get
 char *
 str_get(str)
@@ -48,6 +61,7 @@ STR *str;
  * dlb the following functions are usually macros.
  */
 #ifndef str_true
+int
 str_true(Str)
 STR *Str;
 {
@@ -81,7 +95,7 @@ STR *Str;
 char *
 str_grow(str,newlen)
 register STR *str;
-#ifndef MSDOS
+#ifndef DOSISH
 register int newlen;
 #else
 unsigned long newlen;
@@ -99,7 +113,7 @@ unsigned long newlen;
 	str->str_len += str->str_u.str_useful;
 	str->str_ptr -= str->str_u.str_useful;
 	str->str_u.str_useful = 0L;
-	bcopy(s, str->str_ptr, str->str_cur+1);
+	Move(s, str->str_ptr, str->str_cur+1, char);
 	s = str->str_ptr;
 	str->str_state = SS_NORM;			/* normal again */
 	if (newlen > str->str_len)
@@ -116,6 +130,7 @@ unsigned long newlen;
     return s;
 }
 
+void
 str_numset(str,num)
 register STR *str;
 double num;
@@ -212,6 +227,7 @@ register STR *str;
  * as temporary.
  */
 
+void
 str_sset(dstr,sstr)
 STR *dstr;
 register STR *sstr;
@@ -273,6 +289,10 @@ register STR *sstr;
 		char *tmps = dstr->str_ptr;
 
 		if (*tmps == 'S' && bcmp(tmps,"StB",4) == 0) {
+		    if (dstr->str_magic && dstr->str_magic->str_rare == 'X') {
+			str_free(dstr->str_magic);
+			dstr->str_magic = Nullstr;
+		    }
 		    if (!dstr->str_magic) {
 			dstr->str_magic = str_smake(sstr->str_magic);
 			dstr->str_magic->str_rare = 'X';
@@ -296,6 +316,7 @@ register STR *sstr;
     }
 }
 
+void
 str_nset(str,ptr,len)
 register STR *str;
 register char *ptr;
@@ -305,7 +326,7 @@ register STRLEN len;
 	return;
     STR_GROW(str, len + 1);
     if (ptr)
-	(void)bcopy(ptr,str->str_ptr,len);
+	Move(ptr,str->str_ptr,len,char);
     str->str_cur = len;
     *(str->str_ptr+str->str_cur) = '\0';
     str->str_nok = 0;		/* invalidate number */
@@ -315,6 +336,7 @@ register STRLEN len;
 #endif
 }
 
+void
 str_set(str,ptr)
 register STR *str;
 register char *ptr;
@@ -327,7 +349,7 @@ register char *ptr;
 	ptr = "";
     len = strlen(ptr);
     STR_GROW(str, len + 1);
-    (void)bcopy(ptr,str->str_ptr,len+1);
+    Move(ptr,str->str_ptr,len+1,char);
     str->str_cur = len;
     str->str_nok = 0;		/* invalidate number */
     str->str_pok = 1;		/* validate pointer */
@@ -336,6 +358,7 @@ register char *ptr;
 #endif
 }
 
+void
 str_chop(str,ptr)	/* like set but assuming ptr is in str */
 register STR *str;
 register char *ptr;
@@ -358,6 +381,7 @@ register char *ptr;
     str->str_pok = 1;		/* validate pointer (and unstudy str) */
 }
 
+void
 str_ncat(str,ptr,len)
 register STR *str;
 register char *ptr;
@@ -368,7 +392,7 @@ register STRLEN len;
     if (!(str->str_pok))
 	(void)str_2ptr(str);
     STR_GROW(str, str->str_cur + len + 1);
-    (void)bcopy(ptr,str->str_ptr+str->str_cur,len);
+    Move(ptr,str->str_ptr+str->str_cur,len,char);
     str->str_cur += len;
     *(str->str_ptr+str->str_cur) = '\0';
     str->str_nok = 0;		/* invalidate number */
@@ -378,6 +402,7 @@ register STRLEN len;
 #endif
 }
 
+void
 str_scat(dstr,sstr)
 STR *dstr;
 register STR *sstr;
@@ -393,6 +418,7 @@ register STR *sstr;
 	str_ncat(dstr,sstr->str_ptr,sstr->str_cur);
 }
 
+void
 str_cat(str,ptr)
 register STR *str;
 register char *ptr;
@@ -407,7 +433,7 @@ register char *ptr;
 	(void)str_2ptr(str);
     len = strlen(ptr);
     STR_GROW(str, str->str_cur + len + 1);
-    (void)bcopy(ptr,str->str_ptr+str->str_cur,len+1);
+    Move(ptr,str->str_ptr+str->str_cur,len+1,char);
     str->str_cur += len;
     str->str_nok = 0;		/* invalidate number */
     str->str_pok = 1;		/* validate pointer */
@@ -530,13 +556,13 @@ STRLEN littlelen;
 	*bigend = '\0';
 	while (midend > mid)		/* shove everything down */
 	    *--bigend = *--midend;
-	(void)bcopy(little,big+offset,littlelen);
+	Move(little,big+offset,littlelen,char);
 	bigstr->str_cur += i;
 	STABSET(bigstr);
 	return;
     }
     else if (i == 0) {
-	(void)bcopy(little,bigstr->str_ptr+offset,len);
+	Move(little,bigstr->str_ptr+offset,len,char);
 	STABSET(bigstr);
 	return;
     }
@@ -551,12 +577,12 @@ STRLEN littlelen;
 
     if (mid - big > bigend - midend) {	/* faster to shorten from end */
 	if (littlelen) {
-	    (void)bcopy(little, mid, littlelen);
+	    Move(little, mid, littlelen,char);
 	    mid += littlelen;
 	}
 	i = bigend - midend;
 	if (i > 0) {
-	    (void)bcopy(midend, mid, i);
+	    Move(midend, mid, i,char);
 	    mid += i;
 	}
 	*mid = '\0';
@@ -571,12 +597,12 @@ STRLEN littlelen;
 	while (i--)
 	    *--midend = *--big;
 	if (littlelen)
-	    (void)bcopy(little, mid, littlelen);
+	    Move(little, mid, littlelen,char);
     }
     else if (littlelen) {
 	midend -= littlelen;
 	str_chop(bigstr,midend);
-	(void)bcopy(little,midend,littlelen);
+	Move(little,midend,littlelen,char);
     }
     else {
 	str_chop(bigstr,midend);
@@ -679,6 +705,7 @@ register STR *str;
 	return 0;
 }
 
+int
 str_eq(str1,str2)
 register STR *str1;
 register STR *str2;
@@ -699,6 +726,7 @@ register STR *str2;
     return !bcmp(str1->str_ptr, str2->str_ptr, str1->str_cur);
 }
 
+int
 str_cmp(str1,str2)
 register STR *str1;
 register STR *str2;
@@ -747,6 +775,15 @@ int append;
 
     if (str == &str_undef)
 	return Nullch;
+    if (rspara) {		/* have to do this both before and after */
+	do {			/* to make sure file boundaries work right */
+	    i = getc(fp);
+	    if (i != '\n') {
+		ungetc(i,fp);
+		break;
+	    }
+	} while (i != EOF);
+    }
 #ifdef STDSTDIO		/* Here is some breathtakingly efficient cheating */
     cnt = fp->_cnt;			/* get count into register */
     str->str_nok = 0;			/* invalidate number */
@@ -849,6 +886,15 @@ screamer:
 
 #endif /* STDSTDIO */
 
+    if (rspara) {
+        while (i != EOF) {
+	    i = getc(fp);
+	    if (i != '\n') {
+		ungetc(i,fp);
+		break;
+	    }
+	}
+    }
     return str->str_cur - append ? str->str_ptr : Nullch;
 }
 
@@ -906,7 +952,8 @@ STR *str;
     if (cmd->c_type != C_EXPR || cmd->c_next || arg->arg_type != O_LIST)
 	fatal("panic: error in parselist %d %x %d", cmd->c_type,
 	  cmd->c_next, arg ? arg->arg_type : -1);
-    Safefree(cmd);
+    cmd->c_expr = Nullarg;
+    cmd_free(cmd);
     eval_root = Nullcmd;
     return arg;
 }
@@ -945,10 +992,6 @@ STR *src;
 		if (*nointrp) {		/* in a regular expression */
 		    if (*s == '@')	/* always strip \@ */ /*SUPPRESS 530*/
 			;
-		    else if (*s == '$') {
-			if (s+1 >= send || index(nointrp, s[1]))
-			    str_ncat(str,s-1,1); /* only strip \$ for vars */
-		    }
 		    else		/* don't strip \\, \[, \{ etc. */
 			str_ncat(str,s-1,1);
 		}
@@ -988,27 +1031,30 @@ STR *src;
 		do {
 		    switch (*s) {
 		    case '[':
-			if (s[-1] != '$')
-			    brackets++;
+			brackets++;
 			break;
 		    case '{':
 			brackets++;
 			break;
 		    case ']':
-			if (s[-1] != '$')
-			    brackets--;
+			brackets--;
 			break;
 		    case '}':
 			brackets--;
 			break;
+		    case '$':
+		    case '%':
+		    case '@':
+		    case '&':
+		    case '*':
+			s = scanident(s,send,tokenbuf);
+			break;
 		    case '\'':
 		    case '"':
-			if (s[-1] != '$') {
-			    /*SUPPRESS 68*/
-			    s = cpytill(tokenbuf,s+1,send,*s,&len);
-			    if (s >= send)
-				fatal("Unterminated string");
-			}
+			/*SUPPRESS 68*/
+			s = cpytill(tokenbuf,s+1,send,*s,&len);
+			if (s >= send)
+			    fatal("Unterminated string");
 			break;
 		    }
 		    s++;
@@ -1254,6 +1300,7 @@ int sp;
     return str;
 }
 
+static void
 ucase(s,send)
 register char *s;
 register char *send;
@@ -1265,6 +1312,7 @@ register char *send;
     }
 }
 
+static void
 lcase(s,send)
 register char *s;
 register char *send;
@@ -1381,7 +1429,7 @@ STR *
 str_2mortal(str)
 register STR *str;
 {
-    if (str == &str_undef)
+    if (!str || str == &str_undef)
 	return str;
     if (++tmps_max > tmps_size) {
 	tmps_size = tmps_max;
@@ -1439,7 +1487,7 @@ register STR *old;
 	Str_Grow(old,0);
     if (new->str_ptr)
 	Safefree(new->str_ptr);
-    Copy(old,new,1,STR);
+    StructCopy(old,new,STR);
     if (old->str_ptr) {
 	new->str_ptr = nsavestr(old->str_ptr,old->str_len);
 	new->str_pok &= ~SP_TEMP;
@@ -1447,6 +1495,7 @@ register STR *old;
     return new;
 }
 
+void
 str_reset(s,stash)
 register char *s;
 HASH *stash;
@@ -1504,6 +1553,7 @@ HASH *stash;
 }
 
 #ifdef TAINT
+void
 taintproper(s)
 char *s;
 {
@@ -1511,7 +1561,7 @@ char *s;
     if (debug & 2048)
 	fprintf(stderr,"%s %d %d %d\n",s,tainted,uid, euid);
 #endif
-    if (tainted && (!euid || euid != uid || egid != gid)) {
+    if (tainted && (!euid || euid != uid || egid != gid || taintanyway)) {
 	if (!unsafe)
 	    fatal("%s", s);
 	else if (dowarn)
@@ -1519,6 +1569,7 @@ char *s;
     }
 }
 
+void
 taintenv()
 {
     register STR *envstr;
diff --git a/x2p/s2p.SH b/x2p/s2p.SH
index 818d36211b..6bb8c51c68 100644
--- a/x2p/s2p.SH
+++ b/x2p/s2p.SH
@@ -20,18 +20,27 @@ echo "Extracting s2p (with variable substitutions)"
 : Move anything that needs config subs from !NO!SUBS! section to !GROK!THIS!.
 : Protect any dollar signs and backticks that you do not want interpreted
 : by putting a backslash in front.  You may delete these comments.
+rm -f s2p
 $spitshell >s2p <<!GROK!THIS!
 #!$bin/perl
 
+eval 'exec $bin/perl -S \$0 \${1+"\$@"}'
+	if \$running_under_some_shell;
+
 \$bin = '$bin';
 !GROK!THIS!
 
 : In the following dollars and backticks do not need the extra backslash.
 $spitshell >>s2p <<'!NO!SUBS!'
 
-# $RCSfile: s2p.SH,v $$Revision: 4.0.1.1 $$Date: 91/06/07 12:19:18 $
+# $RCSfile: s2p.SH,v $$Revision: 4.0.1.2 $$Date: 92/06/08 17:26:31 $
 #
 # $Log:	s2p.SH,v $
+# Revision 4.0.1.2  92/06/08  17:26:31  lwall
+# patch20: s2p didn't output portable startup code
+# patch20: added ... as variant on ..
+# patch20: s2p didn't translate s/pat/\&/ or s/pat/\$/ or s/pat/\\1/ right
+# 
 # Revision 4.0.1.1  91/06/07  12:19:18  lwall
 # patch4: s2p now handles embedded newlines better and optimizes common idioms
 # 
@@ -162,7 +171,12 @@ while (<>) {
 	} else {
 	    &Die("Invalid second address at line $.\n");
 	}
-	$addr1 .= " .. $addr2";
+	if ($addr2 =~ /^\d+$/) {
+	    $addr1 .= "..$addr2";
+	}
+	else {
+	    $addr1 .= "...$addr2";
+	}
     }
 
     # Now we check for metacommands {, }, and ! and worry
@@ -488,6 +502,19 @@ EOT
 		      substr($_,$i,1) =~ /^[<>]$/) {
 			substr($_,$i,1) = 'b';
 		    }
+		    elsif ($repl && substr($_,$i,1) =~ /^\d$/) {
+			substr($_,$i-1,1) = '$';
+		    }
+		}
+		elsif ($c eq '&' && $repl) {
+		    substr($_, $i, 0) = '$';
+		    $i++;
+		    $len++;
+		}
+		elsif ($c eq '$' && $repl) {
+		    substr($_, $i, 0) = '\\';
+		    $i++;
+		    $len++;
 		}
 		elsif ($c eq '[' && !$repl) {
 		    $i++ if substr($_,$i,1) eq '^';
@@ -515,9 +542,6 @@ EOT
 	    $end = substr($_, $end + 1, 1000);
 	    &simplify($pat);
 	    $dol = '$';
-	    $repl =~ s/\$/\\$/;
-	    $repl =~ s'&'$&'g;
-	    $repl =~ s/[\\]([0-9])/$dol$1/g;
 	    $subst = "$pat$repl$delim";
 	    $cmd = '';
 	    while ($end) {