perl 4.0 patch 16: patch #11, continued

See patch #11.

10 files changed, 263 insertions, 121 deletions

diff --git a/hints/stellar.sh b/hints/stellar.sh
new file mode 100644
index 0000000000..23e15e9091
--- /dev/null
+++ b/hints/stellar.sh
@@ -0,0 +1,2 @@
+optimize="-O0"
+ccflags="$ccflags -nw"
diff --git a/lib/perldb.pl b/lib/perldb.pl
index 8d1605426c..917469b492 100644
--- a/lib/perldb.pl
+++ b/lib/perldb.pl
@@ -1,6 +1,10 @@
 package DB;
 
-$header = '$RCSfile: perldb.pl,v $$Revision: 4.0.1.1 $$Date: 91/06/07 11:17:44 $';
+# modified Perl debugger, to be run from Emacs in perldb-mode
+# Ray Lischner (uunet!mntgfx!lisch) as of 5 Nov 1990
+# Johan Vromans -- upgrade to 4.0 pl 10
+
+$header = '$RCSfile: perldb.pl,v $$Revision: 4.0.1.2 $$Date: 91/11/05 17:55:58 $';
 #
 # This file is automatically included if you do perl -d.
 # It's probably not useful to include this yourself.
@@ -10,6 +14,9 @@ $header = '$RCSfile: perldb.pl,v $$Revision: 4.0.1.1 $$Date: 91/06/07 11:17:44 $
 # have a breakpoint.  It also inserts a do 'perldb.pl' before the first line.
 #
 # $Log:	perldb.pl,v $
+# Revision 4.0.1.2  91/11/05  17:55:58  lwall
+# patch11: perldb.pl modified to run within emacs in perldb-mode
+# 
 # Revision 4.0.1.1  91/06/07  11:17:44  lwall
 # patch4: added $^P variable to control calling of perldb routines
 # patch4: debugger sometimes listed wrong number of lines for a statement
@@ -57,8 +64,16 @@ select(STDOUT);
 $| = 1;				# for real STDOUT
 $sub = '';
 
+# Is Perl being run from Emacs?
+$emacs = $main'ARGV[$[] eq '-emacs';
+shift(@main'ARGV) if $emacs;
+
 $header =~ s/.Header: ([^,]+),v(\s+\S+\s+\S+).*$/$1$2/;
-print OUT "\nLoading DB routines from $header\n\nEnter h for help.\n\n";
+print OUT "\nLoading DB routines from $header\n";
+print OUT ("Emacs support ",
+	   $emacs ? "enabled" : "available",
+	   ".\n");
+print OUT "\nEnter h for help.\n\n";
 
 sub DB {
     &save;
@@ -78,11 +93,15 @@ sub DB {
 	}
     }
     if ($single || $trace || $signal) {
-	print OUT "$package'" unless $sub =~ /'/;
-	print OUT "$sub($filename:$line):\t",$dbline[$line];
-	for ($i = $line + 1; $i <= $max && $dbline[$i] == 0; ++$i) {
-	    last if $dbline[$i] =~ /^\s*(;|}|#|\n)/;
-	    print OUT "$sub($filename:$i):\t",$dbline[$i];
+	if ($emacs) {
+	    print OUT "\032\032$filename:$line:0\n";
+	} else {
+	    print OUT "$package'" unless $sub =~ /'/;
+	    print OUT "$sub($filename:$line):\t",$dbline[$line];
+	    for ($i = $line + 1; $i <= $max && $dbline[$i] == 0; ++$i) {
+		last if $dbline[$i] =~ /^\s*(}|#|\n)/;
+		print OUT "$sub($filename:$i):\t",$dbline[$i];
+	    }
 	}
     }
     $evalarg = $action, &eval if $action;
@@ -244,9 +263,14 @@ command		Execute as a perl statement in current package.
 		    $i = $2;
 		    $i = $line if $i eq '.';
 		    $i = 1 if $i < 1;
-		    for (; $i <= $end; $i++) {
-			print OUT "$i:\t", $dbline[$i];
-			last if $signal;
+		    if ($emacs) {
+			print OUT "\032\032$filename:$i:0\n";
+			$i = $end;
+		    } else {
+			for (; $i <= $end; $i++) {
+			    print OUT "$i:\t", $dbline[$i];
+			    last if $signal;
+			}
 		    }
 		    $start = $i;	# remember in case they want more
 		    $start = $max if $start > $max;
@@ -393,7 +417,11 @@ command		Execute as a perl statement in current package.
 			$start = 1 if ($start > $max);
 			last if ($start == $end);
 			if ($dbline[$start] =~ m'."\n$pat\n".'i) {
-			    print OUT "$start:\t", $dbline[$start], "\n";
+			    if ($emacs) {
+				print OUT "\032\032$filename:$start:0\n";
+			    } else {
+				print OUT "$start:\t", $dbline[$start], "\n";
+			    }
 			    last;
 			}
 		    } ';
@@ -417,7 +445,11 @@ command		Execute as a perl statement in current package.
 			$start = $max if ($start <= 0);
 			last if ($start == $end);
 			if ($dbline[$start] =~ m'."\n$pat\n".'i) {
-			    print OUT "$start:\t", $dbline[$start], "\n";
+			    if ($emacs) {
+				print OUT "\032\032$filename:$start:0\n";
+			    } else {
+				print OUT "$start:\t", $dbline[$start], "\n";
+			    }
 			    last;
 			}
 		    } ';
diff --git a/patchlevel.h b/patchlevel.h
index 69d9c2fd72..29d912735e 100644
--- a/patchlevel.h
+++ b/patchlevel.h
@@ -1 +1 @@
-#define PATCHLEVEL 15
+#define PATCHLEVEL 16
diff --git a/perly.y b/perly.y
index 4032e10b1d..5f31fd1c3c 100644
--- a/perly.y
+++ b/perly.y
@@ -1,4 +1,4 @@
-/* $RCSfile: perly.y,v $$Revision: 4.0.1.1 $$Date: 91/06/07 11:42:34 $
+/* $RCSfile: perly.y,v $$Revision: 4.0.1.2 $$Date: 91/11/05 18:17:38 $
  *
  *    Copyright (c) 1991, Larry Wall
  *
@@ -6,6 +6,11 @@
  *    License or the Artistic License, as specified in the README file.
  *
  * $Log:	perly.y,v $
+ * Revision 4.0.1.2  91/11/05  18:17:38  lwall
+ * patch11: extra comma at end of list is now allowed in more places (Hi, Felix!)
+ * patch11: once-thru blocks didn't display right in the debugger
+ * patch11: debugger got confused over nested subroutine definitions
+ * 
  * Revision 4.0.1.1  91/06/07  11:42:34  lwall
  * patch4: new copyright notice
  * 
@@ -18,6 +23,10 @@
 #include "INTERN.h"
 #include "perl.h"
 
+/*SUPPRESS 530*/
+/*SUPPRESS 593*/
+/*SUPPRESS 595*/
+
 STAB *scrstab;
 ARG *arg4;	/* rarely used arguments to make_op() */
 ARG *arg5;
@@ -36,6 +45,8 @@ ARG *arg5;
     FCMD *formval;
 }
 
+%token <ival> '{' ')'
+
 %token <cval> WORD
 %token <ival> APPEND OPEN SSELECT LOOPEX
 %token <ival> USING FORMAT DO SHIFT PUSH POP LVALFUN
@@ -49,7 +60,7 @@ ARG *arg5;
 %token <arg> SUBST PATTERN
 %token <arg> RSTRING TRANS
 
-%type <ival> prog decl format remember
+%type <ival> prog decl format remember crp
 %type <cmdval> block lineseq line loop cond sideff nexpr else
 %type <arg> expr sexpr cexpr csexpr term handle aryword hshword
 %type <arg> texpr listop bareword
@@ -110,6 +121,8 @@ else	:	/* NULL */
 
 block	:	'{' remember lineseq '}'
 			{ $$ = block_head($3);
+			  if (cmdline > $1)
+			      cmdline = $1;
 			  if (savestack->ary_fill > $2)
 			    restorelist($2); }
 	;
@@ -190,7 +203,7 @@ loop	:	label WHILE '(' texpr ')' compblock
 			{ cmdline = $2;
 			    $$ = wopt(add_label($1,
 			    invert(make_ccmd(C_WHILE, cmd_to_arg($3),$4)) )); }
-	|	label FOR REG '(' expr ')' compblock
+	|	label FOR REG '(' expr crp compblock
 			{ cmdline = $2;
 			    /*
 			     * The following gobbledygook catches EXPRs that
@@ -229,7 +242,7 @@ loop	:	label WHILE '(' texpr ')' compblock
 				make_ccmd(C_WHILE,$5,$7) )));
 			    }
 			}
-	|	label FOR '(' expr ')' compblock
+	|	label FOR '(' expr crp compblock
 			{ cmdline = $2;
 			    if ($4->arg_type != O_ARRAY) {
 				scrstab = aadd(genstab());
@@ -303,7 +316,10 @@ format	:	FORMAT WORD '=' FORMLIST
 	;
 
 subrout	:	SUB WORD block
-			{ make_sub($2,$3); }
+			{ make_sub($2,$3);
+			  cmdline = NOLINE;
+			  if (savestack->ary_fill > $1)
+			    restorelist($1); }
 	;
 
 package :	PACKAGE WORD ';'
@@ -443,13 +459,11 @@ term	:	'-' term %prec UMINUS
 				stab2arg(A_STAB,
 				  $1 == O_FTTTY?stabent("STDIN",TRUE):defstab),
 				Nullarg, Nullarg); }
-	|	LOCAL '(' expr ')'
+	|	LOCAL '(' expr crp
 			{ $$ = l(localize(make_op(O_ASSIGN, 1,
 				localize(listish(make_list($3))),
 				Nullarg,Nullarg))); }
-	|	'(' expr ',' ')'
-			{ $$ = make_list($2); }
-	|	'(' expr ')'
+	|	'(' expr crp
 			{ $$ = make_list($2); }
 	|	'(' ')'
 			{ $$ = make_list(Nullarg); }
@@ -478,7 +492,7 @@ term	:	'-' term %prec UMINUS
 				stab2arg(A_STAB,hadd($1)),
 				jmaybe($3),
 				Nullarg); }
-	|	'(' expr ')' '[' expr ']'	%prec '('
+	|	'(' expr crp '[' expr ']'	%prec '('
 			{ $$ = make_op(O_LSLICE, 3,
 				Nullarg,
 				listish(make_list($5)),
@@ -513,40 +527,40 @@ term	:	'-' term %prec UMINUS
 			{ $$ = $1; }
 	|	TRANS	%prec '('
 			{ $$ = $1; }
-	|	DO WORD '(' expr ')'
+	|	DO WORD '(' expr crp
 			{ $$ = make_op((perldb ? O_DBSUBR : O_SUBR), 2,
-				stab2arg(A_WORD,stabent($2,TRUE)),
+				stab2arg(A_WORD,stabent($2,MULTI)),
 				make_list($4),
 				Nullarg); Safefree($2); $2 = Nullch;
 			    $$->arg_flags |= AF_DEPR; }
-	|	AMPER WORD '(' expr ')'
+	|	AMPER WORD '(' expr crp
 			{ $$ = make_op((perldb ? O_DBSUBR : O_SUBR), 2,
-				stab2arg(A_WORD,stabent($2,TRUE)),
+				stab2arg(A_WORD,stabent($2,MULTI)),
 				make_list($4),
 				Nullarg); Safefree($2); $2 = Nullch; }
 	|	DO WORD '(' ')'
 			{ $$ = make_op((perldb ? O_DBSUBR : O_SUBR), 2,
-				stab2arg(A_WORD,stabent($2,TRUE)),
+				stab2arg(A_WORD,stabent($2,MULTI)),
 				make_list(Nullarg),
 				Nullarg);
 			    $$->arg_flags |= AF_DEPR; }
 	|	AMPER WORD '(' ')'
 			{ $$ = make_op((perldb ? O_DBSUBR : O_SUBR), 2,
-				stab2arg(A_WORD,stabent($2,TRUE)),
+				stab2arg(A_WORD,stabent($2,MULTI)),
 				make_list(Nullarg),
 				Nullarg); }
 	|	AMPER WORD
 			{ $$ = make_op((perldb ? O_DBSUBR : O_SUBR), 2,
-				stab2arg(A_WORD,stabent($2,TRUE)),
+				stab2arg(A_WORD,stabent($2,MULTI)),
 				Nullarg,
 				Nullarg); }
-	|	DO REG '(' expr ')'
+	|	DO REG '(' expr crp
 			{ $$ = make_op((perldb ? O_DBSUBR : O_SUBR), 2,
 				stab2arg(A_STAB,$2),
 				make_list($4),
 				Nullarg);
 			    $$->arg_flags |= AF_DEPR; }
-	|	AMPER REG '(' expr ')'
+	|	AMPER REG '(' expr crp
 			{ $$ = make_op((perldb ? O_DBSUBR : O_SUBR), 2,
 				stab2arg(A_STAB,$2),
 				make_list($4),
@@ -574,10 +588,18 @@ term	:	'-' term %prec UMINUS
 			    Nullarg,Nullarg); }
 	|	UNIOP
 			{ $$ = make_op($1,0,Nullarg,Nullarg,Nullarg); }
+	|	UNIOP block
+			{ $$ = make_op($1,1,cmd_to_arg($2),Nullarg,Nullarg); }
 	|	UNIOP sexpr
 			{ $$ = make_op($1,1,$2,Nullarg,Nullarg); }
 	|	SSELECT
 			{ $$ = make_op(O_SELECT, 0, Nullarg, Nullarg, Nullarg);}
+	|	SSELECT  WORD
+			{ $$ = make_op(O_SELECT, 1,
+			    stab2arg(A_WORD,stabent($2,TRUE)),
+			    Nullarg,
+			    Nullarg);
+			    Safefree($2); $2 = Nullch; }
 	|	SSELECT '(' handle ')'
 			{ $$ = make_op(O_SELECT, 1, $3, Nullarg, Nullarg); }
 	|	SSELECT '(' sexpr csexpr csexpr csexpr ')'
@@ -628,10 +650,10 @@ term	:	'-' term %prec UMINUS
 	|	FILOP25 '(' handle ',' handle csexpr csexpr cexpr ')'
 			{ arg4 = $7; arg5 = $8;
 			  $$ = make_op($1, 5, $3, $5, $6); }
-	|	PUSH '(' aryword cexpr ')'
+	|	PUSH '(' aryword ',' expr crp
 			{ $$ = make_op($1, 2,
 			    $3,
-			    make_list($4),
+			    make_list($5),
 			    Nullarg); }
 	|	POP aryword	%prec '('
 			{ $$ = make_op(O_POP, 1, $2, Nullarg, Nullarg); }
@@ -671,7 +693,7 @@ term	:	'-' term %prec UMINUS
 			    $3,
 			    listish(make_list($4)),
 			    Nullarg); }
-	|	FLIST '(' expr ')'
+	|	FLIST '(' expr crp
 			{ $$ = make_op($1, 1,
 			    make_list($3),
 			    Nullarg,
@@ -752,6 +774,11 @@ listop	:	LISTOP
 				stab2arg(A_STAB,$2),
 				maybelistish($1,make_list($3)),
 				Nullarg); }
+	|	LISTOP block expr
+			{ $$ = make_op($1,2,
+				cmd_to_arg($2),
+				maybelistish($1,make_list($3)),
+				Nullarg); }
 	;
 
 handle	:	WORD
@@ -774,6 +801,12 @@ hshword	:	WORD
 			{ $$ = stab2arg(A_STAB,$1); }
 	;
 
+crp	:	',' ')'
+			{ $$ = 1; }
+	|	')'
+			{ $$ = 0; }
+	;
+
 /*
  * NOTE:  The following entry must stay at the end of the file so that
  * reduce/reduce conflicts resolve to it only if it's the only option.
@@ -785,7 +818,7 @@ bareword:	WORD
 			    $$->arg_type = O_ITEM;
 			    $$[1].arg_type = A_SINGLE;
 			    $$[1].arg_ptr.arg_str = str_make($1,0);
-			    for (s = $1; *s && islower(*s); s++) ;
+			    for (s = $1; *s && isLOWER(*s); s++) ;
 			    if (dowarn && !*s)
 				warn(
 				  "\"%s\" may clash with future reserved word",
diff --git a/regcomp.c b/regcomp.c
index 92e43a3c58..0fd50c0e5e 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.2 $$Date: 91/06/07 11:48:24 $
+/* $RCSfile: regcomp.c,v $$Revision: 4.0.1.3 $$Date: 91/11/05 18:22:28 $
  *
  * $Log:	regcomp.c,v $
+ * Revision 4.0.1.3  91/11/05  18:22:28  lwall
+ * patch11: minimum match length calculation in regexp is now cumulative
+ * patch11: initial .* in pattern had dependency on value of $*
+ * patch11: certain patterns made use of garbage pointers from uncleared memory
+ * patch11: prepared for ctype implementations that don't define isascii()
+ * 
  * Revision 4.0.1.2  91/06/07  11:48:24  lwall
  * patch4: new copyright notice
  * patch4: /(x+) \1/ incorrectly optimized to not match "xxx xx"
@@ -22,7 +28,7 @@
  * 4.0 baseline.
  * 
  */
-
+/*SUPPRESS 112*/
 /*
  * regcomp and regexec -- regsub and regerror are not used in perl
  *
@@ -150,6 +156,7 @@ int fold;
 	int backish;
 	int backest;
 	int curback;
+	int minlen;
 	extern char *safemalloc();
 	extern char *savestr();
 	int sawplus = 0;
@@ -168,7 +175,7 @@ int fold;
 	regnpar = 1;
 	regsize = 0L;
 	regcode = &regdummy;
-	regc(MAGIC);
+	regc((char)MAGIC);
 	if (reg(0, &flags) == NULL) {
 		Safefree(regprecomp);
 		regprecomp = Nullch;
@@ -193,7 +200,7 @@ int fold;
 	regparse = exp;
 	regnpar = 1;
 	regcode = r->program;
-	regc(MAGIC);
+	regc((char)MAGIC);
 	if (reg(0, &flags) == NULL)
 		return(NULL);
 
@@ -233,7 +240,8 @@ int fold;
 			r->regstclass = first;
 		else if (OP(first) == BOL ||
 		    (OP(first) == STAR && OP(NEXTOPER(first)) == ANY) ) {
-			r->reganch = ROPT_ANCH;	/* kinda turn .* into ^.* */
+			/* kinda turn .* into ^.* */
+			r->reganch = ROPT_ANCH | ROPT_IMPLICIT;
 			first = NEXTOPER(first);
 		    	goto again;
 		}
@@ -259,6 +267,7 @@ int fold;
 		longish = str_make("",0);
 		longest = str_make("",0);
 		len = 0;
+		minlen = 0;
 		curback = 0;
 		backish = 0;
 		backest = 0;
@@ -278,6 +287,7 @@ int fold;
 			    first = scan;
 			    while (OP(t = regnext(scan)) == CLOSE)
 				scan = t;
+			    minlen += *OPERAND(first);
 			    if (curback - backish == len) {
 				str_ncat(longish, OPERAND(first)+1,
 				    *OPERAND(first));
@@ -303,9 +313,16 @@ int fold;
 				backest = backish;
 			    }
 			    str_nset(longish,"",0);
+			    if (OP(scan) == PLUS &&
+			      index(simple,OP(NEXTOPER(scan))))
+				minlen++;
+			    else if (OP(scan) == CURLY &&
+			      index(simple,OP(NEXTOPER(scan)+4)))
+				minlen += ARG1(scan);
 			}
 			else if (index(simple,OP(scan))) {
 			    curback++;
+			    minlen++;
 			    len = 0;
 			    if (longish->str_cur > longest->str_cur) {
 				str_sset(longest,longish);
@@ -328,8 +345,9 @@ int fold;
 		    &&
 		    (!r->regstart
 		     ||
-		     !fbminstr(r->regstart->str_ptr,
-			  r->regstart->str_ptr + r->regstart->str_cur,
+		     !fbminstr((unsigned char*) r->regstart->str_ptr,
+			  (unsigned char *) r->regstart->str_ptr
+			    + r->regstart->str_cur,
 			  longest)
 		    )
 		   )
@@ -354,8 +372,9 @@ int fold;
 
 	r->do_folding = fold;
 	r->nparens = regnpar - 1;
-	New(1002, r->startp, regnpar, char*);
-	New(1002, r->endp, regnpar, char*);
+	r->minlen = minlen;
+	Newz(1002, r->startp, regnpar, char*);
+	Newz(1002, r->endp, regnpar, char*);
 #ifdef DEBUGGING
 	if (debug & 512)
 		regdump(r);
@@ -515,7 +534,7 @@ int *flagp;
 	if (op == '{' && regcurly(regparse)) {
 	    next = regparse + 1;
 	    max = Nullch;
-	    while (isdigit(*next) || *next == ',') {
+	    while (isDIGIT(*next) || *next == ',') {
 		if (*next == ',') {
 		    if (max)
 			break;
@@ -758,7 +777,7 @@ int *flagp;
 			    else {
 				regsawback = 1;
 				ret = reganode(REF, num);
-				while (isascii(*regparse) && isdigit(*regparse))
+				while (isDIGIT(*regparse))
 				    regparse++;
 				*flagp |= SIMPLE;
 			    }
@@ -839,14 +858,14 @@ int *flagp;
 				case 'c':
 				    p++;
 				    ender = *p++;
-				    if (islower(ender))
+				    if (isLOWER(ender))
 					ender = toupper(ender);
 				    ender ^= 64;
 				    break;
 				case '0': case '1': case '2': case '3':case '4':
 				case '5': case '6': case '7': case '8':case '9':
 				    if (*p == '0' ||
-				      (isdigit(p[1]) && atoi(p) >= regnpar) ) {
+				      (isDIGIT(p[1]) && atoi(p) >= regnpar) ) {
 					ender = scanoct(p, 3, &numlen);
 					p += numlen;
 				    }
@@ -868,7 +887,7 @@ int *flagp;
 				ender = *p++;
 				break;
 			    }
-			    if (regfold && isupper(ender))
+			    if (regfold && isUPPER(ender))
 				    ender = tolower(ender);
 			    if (ISMULT2(p)) { /* Back off on ?+*. */
 				if (len)
@@ -992,7 +1011,7 @@ regclass()
 				break;
 			case 'c':
 				class = *regparse++;
-				if (islower(class))
+				if (isLOWER(class))
 				    class = toupper(class);
 				class ^= 64;
 				break;
@@ -1019,7 +1038,7 @@ regclass()
 		}
 		for ( ; lastclass <= class; lastclass++) {
 			regset(bits,def,lastclass);
-			if (regfold && isupper(lastclass))
+			if (regfold && isUPPER(lastclass))
 				regset(bits,def,tolower(lastclass));
 		}
 		lastclass = class;
@@ -1226,13 +1245,13 @@ register char *s;
 {
     if (*s++ != '{')
 	return FALSE;
-    if (!isdigit(*s))
+    if (!isDIGIT(*s))
 	return FALSE;
-    while (isdigit(*s))
+    while (isDIGIT(*s))
 	s++;
     if (*s == ',')
 	s++;
-    while (isdigit(*s))
+    while (isDIGIT(*s))
 	s++;
     if (*s != '}')
 	return FALSE;
@@ -1292,9 +1311,12 @@ regexp *r;
 		fprintf(stderr,"anchored ");
 	if (r->reganch & ROPT_SKIP)
 		fprintf(stderr,"plus ");
+	if (r->reganch & ROPT_IMPLICIT)
+		fprintf(stderr,"implicit ");
 	if (r->regmust != NULL)
 		fprintf(stderr,"must have \"%s\" back %d ", r->regmust->str_ptr,
 		  r->regback);
+	fprintf(stderr, "minlen %d ", r->minlen);
 	fprintf(stderr,"\n");
 }
 
diff --git a/regexec.c b/regexec.c
index bb63eda2e6..226aab4b11 100644
--- a/regexec.c
+++ b/regexec.c
@@ -7,9 +7,13 @@
  * blame Henry for some of the lack of readability.
  */
 
-/* $RCSfile: regexec.c,v $$Revision: 4.0.1.2 $$Date: 91/06/07 11:50:33 $
+/* $RCSfile: regexec.c,v $$Revision: 4.0.1.3 $$Date: 91/11/05 18:23:55 $
  *
  * $Log:	regexec.c,v $
+ * 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 $*
+ * 
  * Revision 4.0.1.2  91/06/07  11:50:33  lwall
  * patch4: new copyright notice
  * patch4: // wouldn't use previous pattern if it started with a null character
@@ -21,7 +25,7 @@
  * 4.0 baseline.
  * 
  */
-
+/*SUPPRESS 112*/
 /*
  * regcomp and regexec -- regsub and regerror are not used in perl
  *
@@ -65,11 +69,6 @@
 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
  */
@@ -221,7 +220,7 @@ int safebase;	/* no need to remember string in subbase */
 	if (prog->reganch & ROPT_ANCH) {
 		if (regtry(prog, string))
 			goto got_it;
-		else if (multiline) {
+		else if (multiline || (prog->reganch & ROPT_IMPLICIT)) {
 			if (minlen)
 			    dontbother = minlen - 1;
 			strend -= dontbother;
@@ -279,6 +278,7 @@ int safebase;	/* no need to remember string in subbase */
 		}
 		goto phooey;
 	}
+	/*SUPPRESS 560*/
 	if (c = prog->regstclass) {
 		int doevery = (prog->reganch & ROPT_SKIP) == 0;
 
@@ -721,6 +721,7 @@ char *prog;
 						if (regmatch(NEXTOPER(scan)))
 							return(1);
 #ifdef REGALIGN
+						/*SUPPRESS 560*/
 						if (n = NEXT(scan))
 						    scan += n;
 						else
diff --git a/stab.c b/stab.c
index b8e76d43b7..d141da3296 100644
--- a/stab.c
+++ b/stab.c
@@ -1,4 +1,4 @@
-/* $RCSfile: stab.c,v $$Revision: 4.0.1.2 $$Date: 91/06/07 11:55:53 $
+/* $RCSfile: stab.c,v $$Revision: 4.0.1.3 $$Date: 91/11/05 18:35:33 $
  *
  *    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.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
+ * patch11: *foo = undef coredumped
+ * patch11: solitary subroutine references no longer trigger typo warnings
+ * patch11: local(*FILEHANDLE) had a memory leak
+ * 
  * Revision 4.0.1.2  91/06/07  11:55:53  lwall
  * patch4: new copyright notice
  * patch4: added $^P variable to control calling of perldb routines
@@ -247,7 +254,7 @@ STR *str;
     char *s;
 
     if (str->str_rare)
-	return stab_val(stab)->str_cur;
+	return str_len(stab_val(stab));
 
     switch (*stab->str_magic->str_ptr) {
     case '1': case '2': case '3': case '4':
@@ -303,7 +310,7 @@ STR *str;
     case '\\':
 	return (STRLEN)orslen;
     default:
-	return stab_str(str)->str_cur;
+	return str_len(stab_str(str));
     }
 }
 
@@ -311,7 +318,7 @@ stabset(mstr,str)
 register STR *mstr;
 STR *str;
 {
-    STAB *stab = mstr->str_u.str_stab;
+    STAB *stab;
     register char *s;
     int i;
 
@@ -338,6 +345,8 @@ STR *str;
     case 'S':
 	s = str_get(str);
 	i = whichsig(mstr->str_ptr);	/* ...no, a brick */
+	if (!i && (dowarn || strEQ(mstr->str_ptr,"ALARM")))
+	    warn("No such signal: SIG%s", mstr->str_ptr);
 	if (strEQ(s,"IGNORE"))
 #ifndef lint
 	    (void)signal(i,SIG_IGN);
@@ -356,6 +365,7 @@ STR *str;
 	break;
 #ifdef SOME_DBM
     case 'D':
+	stab = mstr->str_u.str_stab;
 	hdbmstore(stab_hash(stab),mstr->str_ptr,mstr->str_cur,str);
 	break;
 #endif
@@ -363,6 +373,7 @@ STR *str;
 	{
 	    CMD *cmd;
 
+	    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;
@@ -371,16 +382,19 @@ STR *str;
 	}
 	break;
     case '#':
+	stab = mstr->str_u.str_stab;
 	afill(stab_array(stab), (int)str_gnum(str) - arybase);
 	break;
     case 'X':	/* merely a copy of a * string */
 	break;
     case '*':
-	s = str_get(str);
+	s = str->str_pok ? str_get(str) : "";
 	if (strNE(s,"StB") || str->str_cur != sizeof(STBP)) {
+	    stab = mstr->str_u.str_stab;
 	    if (!*s) {
 		STBP *stbp;
 
+		/*SUPPRESS 701*/
 		(void)savenostab(stab);	/* schedule a free of this stab */
 		if (stab->str_len)
 		    Safefree(stab->str_ptr);
@@ -402,7 +416,7 @@ STR *str;
 		if (!stab_io(stab))
 		    stab_io(stab) = stio_new();
 	    }
-	    str_sset(str,stab);
+	    str_sset(str, (STR*) stab);
 	}
 	break;
     case 's': {
@@ -422,6 +436,9 @@ STR *str;
 	break;
 
     case 0:
+	/*SUPPRESS 560*/
+	if (!(stab = mstr->str_u.str_stab))
+	    break;
 	switch (*stab->str_magic->str_ptr) {
 	case '\004':	/* ^D */
 #ifdef DEBUGGING
@@ -711,6 +728,7 @@ int sig;
 		sig_name[sig], stab_name(stab) );
 	return;
     }
+    /*SUPPRESS 701*/
     saveaptr(&stack);
     str = Str_new(15, sizeof(CSV));
     str->str_state = SS_SCSV;
@@ -791,7 +809,7 @@ int add;
     char *prevquote = Nullch;
     bool global = FALSE;
 
-    if (isascii(*name) && isupper(*name)) {
+    if (isUPPER(*name)) {
 	if (*name > 'I') {
 	    if (*name == 'S' && (
 	      strEQ(name, "SIG") ||
@@ -822,9 +840,9 @@ int add;
 	sawquote = Nullch;
 	name++;
     }
-    else if (!isalpha(*name) || global)
+    else if (!isALPHA(*name) || global)
 	stash = defstash;
-    else if (curcmd == &compiling)
+    else if ((CMD*)curcmd == &compiling)
 	stash = curstash;
     else
 	stash = curcmd->c_stash;
@@ -833,6 +851,7 @@ int add;
 	char *s, *d;
 
 	*sawquote = '\0';
+	/*SUPPRESS 560*/
 	if (s = prevquote) {
 	    strncpy(tmpbuf,name,s-name+1);
 	    d = tmpbuf+(s-name+1);
@@ -869,12 +888,14 @@ int add;
 	strcpy(stab_magic(stab),"StB");
 	stab_val(stab) = Str_new(72,0);
 	stab_line(stab) = curcmd->c_line;
-	str_magic(stab,stab,'*',name,len);
+	str_magic((STR*)stab, stab, '*', name, len);
 	stab_stash(stab) = stash;
-	if (isdigit(*name) && *name != '0') {
+	if (isDIGIT(*name) && *name != '0') {
 	    stab_flags(stab) = SF_VMAGIC;
 	    str_magic(stab_val(stab), stab, 0, Nullch, 0);
 	}
+	if (add & 2)
+	    stab->str_pok |= SP_MULTI;
 	return stab;
     }
 }
@@ -945,11 +966,14 @@ register STAB *stab;
     stab_xhash(stab) = Null(HASH*);
     str_free(stab_val(stab));
     stab_val(stab) = Nullstr;
+    /*SUPPRESS 560*/
     if (stio = stab_io(stab)) {
 	do_close(stab,FALSE);
 	Safefree(stio->top_name);
 	Safefree(stio->fmt_name);
+	Safefree(stio);
     }
+    /*SUPPRESS 560*/
     if (sub = stab_sub(stab)) {
 	afree(sub->tosave);
 	cmd_free(sub->cmd);
diff --git a/stab.h b/stab.h
index ddb7d38e3d..3025342d27 100644
--- a/stab.h
+++ b/stab.h
@@ -1,4 +1,4 @@
-/* $RCSfile: stab.h,v $$Revision: 4.0.1.1 $$Date: 91/06/07 11:56:35 $
+/* $RCSfile: stab.h,v $$Revision: 4.0.1.2 $$Date: 91/11/05 18:36:15 $
  *
  *    Copyright (c) 1991, Larry Wall
  *
@@ -6,6 +6,9 @@
  *    License or the Artistic License, as specified in the README file.
  *
  * $Log:	stab.h,v $
+ * Revision 4.0.1.2  91/11/05  18:36:15  lwall
+ * patch11: length($x) was sometimes wrong for numeric $x
+ * 
  * Revision 4.0.1.1  91/06/07  11:56:35  lwall
  * patch4: new copyright notice
  * patch4: length($`), length($&), length($') now optimized to avoid string copy
@@ -100,7 +103,7 @@ struct sub {
 STRLEN stab_len();
 
 #define STAB_STR(s) (tmpstab = (s), stab_flags(tmpstab) & SF_VMAGIC ? stab_str(stab_val(tmpstab)->str_magic) : stab_val(tmpstab))
-#define STAB_LEN(s) (tmpstab = (s), stab_flags(tmpstab) & SF_VMAGIC ? stab_len(stab_val(tmpstab)->str_magic) : stab_val(tmpstab)->str_cur)
+#define STAB_LEN(s) (tmpstab = (s), stab_flags(tmpstab) & SF_VMAGIC ? stab_len(stab_val(tmpstab)->str_magic) : str_len(stab_val(tmpstab)))
 #define STAB_GET(s) (tmpstab = (s), str_get(stab_flags(tmpstab) & SF_VMAGIC ? stab_str(tmpstab->str_magic) : stab_val(tmpstab)))
 #define STAB_GNUM(s) (tmpstab = (s), str_gnum(stab_flags(tmpstab) & SF_VMAGIC ? stab_str(tmpstab->str_magic) : stab_val(tmpstab)))
 
diff --git a/str.c b/str.c
index cf5e1f902d..4fdc0630c6 100644
--- a/str.c
+++ b/str.c
@@ -1,4 +1,4 @@
-/* $RCSfile: str.c,v $$Revision: 4.0.1.3 $$Date: 91/06/10 01:27:54 $
+/* $RCSfile: str.c,v $$Revision: 4.0.1.4 $$Date: 91/11/05 18:40:51 $
  *
  *    Copyright (c) 1991, Larry Wall
  *
@@ -6,6 +6,11 @@
  *    License or the Artistic License, as specified in the README file.
  *
  * $Log:	str.c,v $
+ * 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
+ * patch11: prepared for ctype implementations that don't define isascii()
+ * 
  * Revision 4.0.1.3  91/06/10  01:27:54  lwall
  * patch10: $) and $| incorrectly handled in run-time patterns
  * 
@@ -255,6 +260,7 @@ register STR *sstr;
 	    }
 	    str_nset(dstr,sstr->str_ptr,sstr->str_cur);
 	}
+	/*SUPPRESS 560*/
 	if (dstr->str_nok = sstr->str_nok)
 	    dstr->str_u.str_nval = sstr->str_u.str_nval;
 	else {
@@ -556,6 +562,7 @@ STRLEN littlelen;
 	*mid = '\0';
 	bigstr->str_cur = mid - big;
     }
+    /*SUPPRESS 560*/
     else if (i = mid - big) {	/* faster from front */
 	midend -= littlelen;
 	mid = midend;
@@ -709,11 +716,13 @@ register STR *str2;
 	(void)str_2ptr(str2);
 
     if (str1->str_cur < str2->str_cur) {
+	/*SUPPRESS 560*/
 	if (retval = memcmp(str1->str_ptr, str2->str_ptr, str1->str_cur))
 	    return retval < 0 ? -1 : 1;
 	else
 	    return -1;
     }
+    /*SUPPRESS 560*/
     else if (retval = memcmp(str1->str_ptr, str2->str_ptr, str2->str_cur))
 	return retval < 0 ? -1 : 1;
     else if (str1->str_cur == str2->str_cur)
@@ -742,7 +751,7 @@ int append;
     cnt = fp->_cnt;			/* get count into register */
     str->str_nok = 0;			/* invalidate number */
     str->str_pok = 1;			/* validate pointer */
-    if (str->str_len <= cnt + 1) {	/* make sure we have the room */
+    if (str->str_len - append <= cnt + 1) { /* make sure we have the room */
 	if (cnt > 80 && str->str_len > append) {
 	    shortbuffered = cnt - str->str_len + append + 1;
 	    cnt -= shortbuffered;
@@ -928,14 +937,21 @@ STR *src;
 	if (*s == '\\' && s[1] && index("$@[{\\]}lLuUE",s[1])) {
 	    str_ncat(str, t, s - t);
 	    ++s;
-	    if (isalpha(*s)) {
+	    if (isALPHA(*s)) {
 		str_ncat(str, "$c", 2);
 		sawcase = (*s != 'E');
 	    }
 	    else {
-		if (*nointrp && s+1 < send)
-		    if (*s != '@' && (*s != '$' || index(nointrp,s[1])))
+		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);
+		}
 		str_ncat(str, "$b", 2);
 	    }
 	    str_ncat(str, s, 1);
@@ -952,7 +968,7 @@ STR *src;
 	else if ((*s == '@' || *s == '$') && s+1 < send) {
 	    str_ncat(str,t,s-t);
 	    t = s;
-	    if (*s == '$' && s[1] == '#' && (isalpha(s[2]) || s[2] == '_'))
+	    if (*s == '$' && s[1] == '#' && (isALPHA(s[2]) || s[2] == '_'))
 		s++;
 	    s = scanident(s,send,tokenbuf);
 	    if (*t == '@' &&
@@ -988,6 +1004,7 @@ STR *src;
 		    case '\'':
 		    case '"':
 			if (s[-1] != '$') {
+			    /*SUPPRESS 68*/
 			    s = cpytill(tokenbuf,s+1,send,*s,&len);
 			    if (s >= send)
 				fatal("Unterminated string");
@@ -1002,10 +1019,10 @@ STR *src;
 		    d = checkpoint;
 		    if (*d == '{' && s[-1] == '}') {	/* maybe {n,m} */
 			++d;
-			if (isdigit(*d)) {	/* matches /^{\d,?\d*}$/ */
+			if (isDIGIT(*d)) {	/* matches /^{\d,?\d*}$/ */
 			    if (*++d == ',')
 				++d;
-			    while (isdigit(*d))
+			    while (isDIGIT(*d))
 				d++;
 			    if (d == s - 1)
 				s = checkpoint;		/* Is {n,m}! Backoff! */
@@ -1022,9 +1039,9 @@ STR *src;
 			    weight += 150;
 			else if (d[1] == '$')
 			    weight -= 3;
-			if (isdigit(d[1])) {
+			if (isDIGIT(d[1])) {
 			    if (d[2]) {
-				if (isdigit(d[2]) && !d[3])
+				if (isDIGIT(d[2]) && !d[3])
 				    weight -= 10;
 			    }
 			    else
@@ -1037,8 +1054,7 @@ STR *src;
 			    case '&':
 			    case '$':
 				weight -= seen[un_char] * 10;
-				if (isalpha(d[1]) || isdigit(d[1]) ||
-				  d[1] == '_') {
+				if (isALNUM(d[1])) {
 				    d = scanident(d,s,tokenbuf);
 				    if (stabent(tokenbuf,FALSE))
 					weight -= 100;
@@ -1062,9 +1078,9 @@ STR *src;
 					weight += 1;
 				    else if (index("rnftb",d[1]))
 					weight += 40;
-				    else if (isdigit(d[1])) {
+				    else if (isDIGIT(d[1])) {
 					weight += 40;
-					while (d[1] && isdigit(d[1]))
+					while (d[1] && isDIGIT(d[1]))
 					    d++;
 				    }
 				}
@@ -1082,7 +1098,7 @@ STR *src;
 				else
 				    weight -= 1;
 			    default:
-				if (isalpha(*d) && d[1] && isalpha(d[1])) {
+				if (isALPHA(*d) && d[1] && isALPHA(d[1])) {
 				    bufptr = d;
 				    if (yylex() != WORD)
 					weight -= 150;
@@ -1243,7 +1259,7 @@ register char *s;
 register char *send;
 {
     while (s < send) {
-	if (isascii(*s) && islower(*s))
+	if (isLOWER(*s))
 	    *s = toupper(*s);
 	s++;
     }
@@ -1254,7 +1270,7 @@ register char *s;
 register char *send;
 {
     while (s < send) {
-	if (isascii(*s) && isupper(*s))
+	if (isUPPER(*s))
 	    *s = tolower(*s);
 	s++;
     }
@@ -1280,22 +1296,22 @@ register STR *str;
 	return;
     }
     d = str->str_ptr;
-    while (isalpha(*d)) d++;
-    while (isdigit(*d)) d++;
+    while (isALPHA(*d)) d++;
+    while (isDIGIT(*d)) d++;
     if (*d) {
         str_numset(str,atof(str->str_ptr) + 1.0);  /* punt */
 	return;
     }
     d--;
     while (d >= str->str_ptr) {
-	if (isdigit(*d)) {
+	if (isDIGIT(*d)) {
 	    if (++*d <= '9')
 		return;
 	    *(d--) = '0';
 	}
 	else {
 	    ++*d;
-	    if (isalpha(*d))
+	    if (isALPHA(*d))
 		return;
 	    *(d--) -= 'z' - 'a' + 1;
 	}
@@ -1305,7 +1321,7 @@ register STR *str;
     str->str_cur++;
     for (d = str->str_ptr + str->str_cur; d > str->str_ptr; d--)
 	*d = d[-1];
-    if (isdigit(d[1]))
+    if (isDIGIT(d[1]))
 	*d = '1';
     else
 	*d = d[1];
diff --git a/t/op/stat.t b/t/op/stat.t
index 92da97af82..1d1b22cac8 100644
--- a/t/op/stat.t
+++ b/t/op/stat.t
@@ -1,6 +1,6 @@
 #!./perl
 
-# $RCSfile: stat.t,v $$Revision: 4.0.1.1 $$Date: 91/06/07 12:02:42 $
+# $RCSfile: stat.t,v $$Revision: 4.0.1.2 $$Date: 91/11/05 18:44:44 $
 
 print "1..56\n";
 
@@ -9,15 +9,15 @@ chop($cwd = `pwd`);
 $DEV = `ls -l /dev`;
 
 unlink "Op.stat.tmp";
-open(foo, ">Op.stat.tmp");
+open(FOO, ">Op.stat.tmp");
 
 ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
-    $blksize,$blocks) = stat(foo);
+    $blksize,$blocks) = stat(FOO);
 if ($nlink == 1) {print "ok 1\n";} else {print "not ok 1\n";}
 if ($mtime && $mtime == $ctime) {print "ok 2\n";} else {print "not ok 2\n";}
 
-print foo "Now is the time for all good men to come to.\n";
-close(foo);
+print FOO "Now is the time for all good men to come to.\n";
+close(FOO);
 
 sleep 2;
 
@@ -141,24 +141,33 @@ if (! -B 'op/stat.t') {print "ok 42\n";} else {print "not ok 42\n";}
 if (-B './perl') {print "ok 43\n";} else {print "not ok 43\n";}
 if (! -T './perl') {print "ok 44\n";} else {print "not ok 44\n";}
 
-open(foo,'op/stat.t');
-if (-T foo) {print "ok 45\n";} else {print "not ok 45\n";}
-if (! -B foo) {print "ok 46\n";} else {print "not ok 46\n";}
-$_ = <foo>;
-if (/perl/) {print "ok 47\n";} else {print "not ok 47\n";}
-if (-T foo) {print "ok 48\n";} else {print "not ok 48\n";}
-if (! -B foo) {print "ok 49\n";} else {print "not ok 49\n";}
-close(foo);
-
-open(foo,'op/stat.t');
-$_ = <foo>;
-if (/perl/) {print "ok 50\n";} else {print "not ok 50\n";}
-if (-T foo) {print "ok 51\n";} else {print "not ok 51\n";}
-if (! -B foo) {print "ok 52\n";} else {print "not ok 52\n";}
-seek(foo,0,0);
-if (-T foo) {print "ok 53\n";} else {print "not ok 53\n";}
-if (! -B foo) {print "ok 54\n";} else {print "not ok 54\n";}
-close(foo);
+open(FOO,'op/stat.t');
+eval { -T FOO; };
+if ($@ =~ /not implemented/) {
+    print "# $@";
+    for (45 .. 54) {
+	print "ok $_\n";
+    }
+}
+else {
+    if (-T FOO) {print "ok 45\n";} else {print "not ok 45\n";}
+    if (! -B FOO) {print "ok 46\n";} else {print "not ok 46\n";}
+    $_ = <FOO>;
+    if (/perl/) {print "ok 47\n";} else {print "not ok 47\n";}
+    if (-T FOO) {print "ok 48\n";} else {print "not ok 48\n";}
+    if (! -B FOO) {print "ok 49\n";} else {print "not ok 49\n";}
+    close(FOO);
+
+    open(FOO,'op/stat.t');
+    $_ = <FOO>;
+    if (/perl/) {print "ok 50\n";} else {print "not ok 50\n";}
+    if (-T FOO) {print "ok 51\n";} else {print "not ok 51\n";}
+    if (! -B FOO) {print "ok 52\n";} else {print "not ok 52\n";}
+    seek(FOO,0,0);
+    if (-T FOO) {print "ok 53\n";} else {print "not ok 53\n";}
+    if (! -B FOO) {print "ok 54\n";} else {print "not ok 54\n";}
+}
+close(FOO);
 
 if (-T '/dev/null') {print "ok 55\n";} else {print "not ok 55\n";}
 if (-B '/dev/null') {print "ok 56\n";} else {print "not ok 56\n";}