perl 4.0 patch 17: patch #11, continued

See patch #11.

11 files changed, 350 insertions, 115 deletions

diff --git a/hints/sunos_4_0_1.sh b/hints/sunos_4_0_1.sh
index 7fd8c889cb..99fce3f44b 100644
--- a/hints/sunos_4_0_1.sh
+++ b/hints/sunos_4_0_1.sh
@@ -1 +1 @@
-$ccflags="$ccflags -DFPUTS_BOTCH"
+ccflags="$ccflags -DFPUTS_BOTCH"
diff --git a/hints/sunos_4_0_2.sh b/hints/sunos_4_0_2.sh
index 7fd8c889cb..99fce3f44b 100644
--- a/hints/sunos_4_0_2.sh
+++ b/hints/sunos_4_0_2.sh
@@ -1 +1 @@
-$ccflags="$ccflags -DFPUTS_BOTCH"
+ccflags="$ccflags -DFPUTS_BOTCH"
diff --git a/hints/ti1500.sh b/hints/ti1500.sh
new file mode 100644
index 0000000000..3d89250b25
--- /dev/null
+++ b/hints/ti1500.sh
@@ -0,0 +1 @@
+d_mymalloc='undef'
diff --git a/hints/ultrix_4.sh b/hints/ultrix_4.sh
index ffaf376272..91e5d7d109 100644
--- a/hints/ultrix_4.sh
+++ b/hints/ultrix_4.sh
@@ -6,6 +6,9 @@ Note that there is a bug in some versions of NFS on the DECStation that
 may cause utime() to work incorrectly.  If so, regression test io/fs
 may fail if run under NFS.  Ignore the failure.
 EOF
+    case "$tmp" in
+    *4.2*) d_volatile=undef;;
+    esac
 ;;
 esac
 case "$tmp" in
diff --git a/patchlevel.h b/patchlevel.h
index 29d912735e..6dbf0692d5 100644
--- a/patchlevel.h
+++ b/patchlevel.h
@@ -1 +1 @@
-#define PATCHLEVEL 16
+#define PATCHLEVEL 17
diff --git a/str.h b/str.h
index 15c2c68731..b2528bca4b 100644
--- a/str.h
+++ b/str.h
@@ -1,4 +1,4 @@
-/* $RCSfile: str.h,v $$Revision: 4.0.1.2 $$Date: 91/06/07 11:58:33 $
+/* $RCSfile: str.h,v $$Revision: 4.0.1.3 $$Date: 91/11/05 18:41:47 $
  *
  *    Copyright (c) 1991, Larry Wall
  *
@@ -6,6 +6,10 @@
  *    License or the Artistic License, as specified in the README file.
  *
  * $Log:	str.h,v $
+ * Revision 4.0.1.3  91/11/05  18:41:47  lwall
+ * patch11: random cleanup
+ * patch11: solitary subroutine references no longer trigger typo warnings
+ * 
  * Revision 4.0.1.2  91/06/07  11:58:33  lwall
  * patch4: new copyright notice
  * 
@@ -32,8 +36,8 @@ struct string {
     STRLEN	str_cur;	/* length of str_ptr as a C string */
     STR		*str_magic;	/* while free, link to next free str */
 				/* while in use, ptr to "key" for magic items */
-    char	str_pok;	/* state of str_ptr */
-    char	str_nok;	/* state of str_nval */
+    unsigned char str_pok;	/* state of str_ptr */
+    unsigned char str_nok;	/* state of str_nval */
     unsigned char str_rare;	/* used by search strings */
     unsigned char str_state;	/* one of SS_* below */
 				/* also used by search strings for backoff */
@@ -57,8 +61,8 @@ struct stab {	/* should be identical, except for str_ptr */
     STRLEN	str_cur;	/* length of str_ptr as a C string */
     STR		*str_magic;	/* while free, link to next free str */
 				/* while in use, ptr to "key" for magic items */
-    char	str_pok;	/* state of str_ptr */
-    char	str_nok;	/* state of str_nval */
+    unsigned char str_pok;	/* state of str_ptr */
+    unsigned char str_nok;	/* state of str_nval */
     unsigned char str_rare;	/* used by search strings */
     unsigned char str_state;	/* one of SS_* below */
 				/* also used by search strings for backoff */
@@ -136,3 +140,5 @@ int str_eq();
 void str_magic();
 void str_insert();
 STRLEN str_len();
+
+#define MULTI	(3)
diff --git a/t/cmd/subval.t b/t/cmd/subval.t
index ba4d833d3a..505025f7f4 100644
--- a/t/cmd/subval.t
+++ b/t/cmd/subval.t
@@ -1,6 +1,6 @@
 #!./perl
 
-# $Header: subval.t,v 4.0 91/03/20 01:49:40 lwall Locked $
+# $RCSfile: subval.t,v $$Revision: 4.0.1.1 $$Date: 91/11/05 18:42:31 $
 
 sub foo1 {
     'true1';
@@ -102,7 +102,7 @@ print $x eq '1:2:3' ? "ok 26\n" : "not ok 26 $x\n";
 sub somesub {
     local($num,$P,$F,$L) = @_;
     ($p,$f,$l) = caller;
-    print "$p:$f:$l" eq "$P:$F:$L" ? "ok $num\n" : "not ok $num\n";
+    print "$p:$f:$l" eq "$P:$F:$L" ? "ok $num\n" : "not ok $num $p:$f:$l ne $P:$F:$L\n";
 }
 
 &somesub(27, 'main', __FILE__, __LINE__);
diff --git a/toke.c b/toke.c
index d46a960913..14ce7f6b0a 100644
--- a/toke.c
+++ b/toke.c
@@ -1,4 +1,4 @@
-/* $RCSfile: toke.c,v $$Revision: 4.0.1.3 $$Date: 91/06/10 01:32:26 $
+/* $RCSfile: toke.c,v $$Revision: 4.0.1.4 $$Date: 91/11/05 19:02:48 $
  *
  *    Copyright (c) 1991, Larry Wall
  *
@@ -6,6 +6,14 @@
  *    License or the Artistic License, as specified in the README file.
  *
  * $Log:	toke.c,v $
+ * Revision 4.0.1.4  91/11/05  19:02:48  lwall
+ * patch11: \x and \c were subject to double interpretation in regexps
+ * patch11: prepared for ctype implementations that don't define isascii()
+ * patch11: nested list operators could miscount parens
+ * patch11: once-thru blocks didn't display right in the debugger
+ * patch11: sort eval "whatever" didn't work
+ * patch11: underscore is now allowed within literal octal and hex numbers
+ * 
  * Revision 4.0.1.3  91/06/10  01:32:26  lwall
  * patch10: m'$foo' now treats string as single quoted
  * patch10: certain pattern optimizations were botched
@@ -41,7 +49,7 @@
 
 /* which backslash sequences to keep in m// or s// */
 
-static char *patleave = "\\.^$@dDwWsSbB+*?|()-nrtf0123456789[{]}";
+static char *patleave = "\\.^$@dDwWsSbB+*?|()-nrtfeaxc0123456789[{]}";
 
 char *reparse;		/* if non-null, scanident found ${foo[$bar]} */
 
@@ -92,7 +100,7 @@ void checkcomma();
  * paren came before the listop rather than after.
  */
 #define LOP(f) return(CLINE, *s == '(' || (s = skipspace(s), *s == '(') ? \
-	(*s = META('('), bufptr = oldbufptr, '(') : \
+	(*s = (char) META('('), bufptr = oldbufptr, '(') : \
 	(yylval.ival=f,expectterm = TRUE,bufptr = s,(int)LISTOP))
 /* grandfather return to old style */
 #define OLDLOP(f) return(yylval.ival=f,expectterm = TRUE,bufptr = s,(int)LISTOP)
@@ -101,7 +109,7 @@ char *
 skipspace(s)
 register char *s;
 {
-    while (s < bufend && isascii(*s) && isspace(*s))
+    while (s < bufend && isSPACE(*s))
 	s++;
     return s;
 }
@@ -175,8 +183,10 @@ yylex()
 #endif
 #ifdef BADSWITCH
     if (*s & 128) {
-	if ((*s & 127) == '(')
+	if ((*s & 127) == '(') {
 	    *s++ = '(';
+	    oldbufptr = s;
+	}
 	else
 	    warn("Unrecognized character \\%03o ignored", *s++ & 255);
 	goto retry;
@@ -184,8 +194,10 @@ yylex()
 #endif
     switch (*s) {
     default:
-	if ((*s & 127) == '(')
+	if ((*s & 127) == '(') {
 	    *s++ = '(';
+	    oldbufptr = s;
+	}
 	else
 	    warn("Unrecognized character \\%03o ignored", *s++ & 255);
 	goto retry;
@@ -238,7 +250,7 @@ yylex()
 		if (rsfp) {
 		    if (preprocess)
 			(void)mypclose(rsfp);
-		    else if (rsfp == stdin)
+		    else if ((FILE*)rsfp == stdin)
 			clearerr(stdin);
 		    else
 			(void)fclose(rsfp);
@@ -283,15 +295,15 @@ yylex()
 		    if (*s == ' ')
 			s++;
 		    cmd = s;
-		    while (s < bufend && !isspace(*s))
+		    while (s < bufend && !isSPACE(*s))
 			s++;
 		    *s++ = '\0';
-		    while (s < bufend && isspace(*s))
+		    while (s < bufend && isSPACE(*s))
 			s++;
 		    if (s < bufend) {
 			Newz(899,newargv,origargc+3,char*);
 			newargv[1] = s;
-			while (s < bufend && !isspace(*s))
+			while (s < bufend && !isSPACE(*s))
 			    s++;
 			*s = '\0';
 			Copy(origargv+1, newargv+2, origargc+1, char*);
@@ -304,7 +316,7 @@ yylex()
 		}
 	    }
 	    else {
-		while (s < bufend && isspace(*s))
+		while (s < bufend && isSPACE(*s))
 		    s++;
 		if (*s == ':')	/* for csh's that have to exec sh scripts */
 		    s++;
@@ -316,11 +328,14 @@ yylex()
 	goto retry;
     case '#':
 	if (preprocess && s == str_get(linestr) &&
-	       s[1] == ' ' && isdigit(s[2])) {
-	    curcmd->c_line = atoi(s+2)-1;
-	    for (s += 2; isdigit(*s); s++) ;
+	       s[1] == ' ' && (isDIGIT(s[2]) || strnEQ(s+2,"line ",5)) ) {
+	    while (*s && !isDIGIT(*s))
+		s++;
+	    curcmd->c_line = atoi(s)-1;
+	    while (isDIGIT(*s))
+		s++;
 	    d = bufend;
-	    while (s < d && isspace(*s)) s++;
+	    while (s < d && isSPACE(*s)) s++;
 	    s[strlen(s)-1] = '\0';	/* wipe out newline */
 	    if (*s == '"') {
 		s++;
@@ -355,7 +370,7 @@ yylex()
 	}
 	goto retry;
     case '-':
-	if (s[1] && isalpha(s[1]) && !isalpha(s[2])) {
+	if (s[1] && isALPHA(s[1]) && !isALPHA(s[2])) {
 	    s++;
 	    switch (*s++) {
 	    case 'r': FTST(O_FTEREAD);
@@ -441,7 +456,8 @@ yylex()
 	OPERATOR(tmp);
     case '{':
 	tmp = *s++;
-	if (isspace(*s) || *s == '#')
+	yylval.ival = curcmd->c_line;
+	if (isSPACE(*s) || *s == '#')
 	    cmdline = NOLINE;   /* invalidate current command line number */
 	OPERATOR(tmp);
     case ';':
@@ -464,9 +480,9 @@ yylex()
 	s--;
 	if (expectterm) {
 	    d = bufend;
-	    while (s < d && isspace(*s))
+	    while (s < d && isSPACE(*s))
 		s++;
-	    if (isalpha(*s) || *s == '_' || *s == '\'')
+	    if (isALPHA(*s) || *s == '_' || *s == '\'')
 		*(--s) = '\\';	/* force next ident to WORD */
 	    OPERATOR(AMPER);
 	}
@@ -526,8 +542,7 @@ yylex()
 
 #define SNARFWORD \
 	d = tokenbuf; \
-	while (isascii(*s) && \
-	  (isalpha(*s) || isdigit(*s) || *s == '_' || *s == '\'')) \
+	while (isALNUM(*s) || *s == '\'') \
 	    *d++ = *s++; \
 	while (d[-1] == '\'') \
 	    d--,s--; \
@@ -535,7 +550,7 @@ yylex()
 	d = tokenbuf;
 
     case '$':
-	if (s[1] == '#' && (isalpha(s[2]) || s[2] == '_')) {
+	if (s[1] == '#' && (isALPHA(s[2]) || s[2] == '_')) {
 	    s++;
 	    s = scanident(s,bufend,tokenbuf);
 	    yylval.stabval = aadd(stabent(tokenbuf,TRUE));
@@ -574,7 +589,7 @@ yylex()
 	OPERATOR(tmp);
 
     case '.':
-	if (!expectterm || !isdigit(s[1])) {
+	if (!expectterm || !isDIGIT(s[1])) {
 	    tmp = *s++;
 	    if (*s == tmp) {
 		s++;
@@ -613,6 +628,7 @@ yylex()
 		STAB *stab;
 		int fd;
 
+		/*SUPPRESS 560*/
 		if (stab = stabent("DATA",FALSE)) {
 		    stab->str_pok |= SP_MULTI;
 		    stab_io(stab) = stio_new();
@@ -623,7 +639,7 @@ yylex()
 #endif
 		    if (preprocess)
 			stab_io(stab)->type = '|';
-		    else if (rsfp == stdin)
+		    else if ((FILE*)rsfp == stdin)
 			stab_io(stab)->type = '-';
 		    else
 			stab_io(stab)->type = '<';
@@ -670,7 +686,10 @@ yylex()
 	    UNI(O_CALLER);
 	if (strEQ(d,"crypt")) {
 #ifdef FCRYPT
-	    init_des();
+	    static int cryptseen = 0;
+
+	    if (!cryptseen++)
+		init_des();
 #endif
 	    FUN2(O_CRYPT);
 	}
@@ -689,9 +708,9 @@ yylex()
 	SNARFWORD;
 	if (strEQ(d,"do")) {
 	    d = bufend;
-	    while (s < d && isspace(*s))
+	    while (s < d && isSPACE(*s))
 		s++;
-	    if (isalpha(*s) || *s == '_')
+	    if (isALPHA(*s) || *s == '_')
 		*(--s) = '\\';	/* force next ident to WORD */
 	    OPERATOR(DO);
 	}
@@ -755,9 +774,9 @@ yylex()
 	}
 	if (strEQ(d,"format")) {
 	    d = bufend;
-	    while (s < d && isspace(*s))
+	    while (s < d && isSPACE(*s))
 		s++;
-	    if (isalpha(*s) || *s == '_')
+	    if (isALPHA(*s) || *s == '_')
 		*(--s) = '\\';	/* force next ident to WORD */
 	    in_format = TRUE;
 	    allstabs = TRUE;		/* must initialize everything since */
@@ -1125,11 +1144,12 @@ yylex()
 	    if (strEQ(d,"sort")) {
 		checkcomma(s,"subroutine name");
 		d = bufend;
-		while (s < d && isascii(*s) && isspace(*s)) s++;
+		while (s < d && isSPACE(*s)) s++;
 		if (*s == ';' || *s == ')')		/* probably a close */
 		    fatal("sort is now a reserved word");
-		if (isascii(*s) && (isalpha(*s) || *s == '_')) {
-		    for (d = s; isalpha(*d) || isdigit(*d) || *d == '_'; d++) ;
+		if (isALPHA(*s) || *s == '_') {
+		    /*SUPPRESS 530*/
+		    for (d = s; isALNUM(*d); d++) ;
 		    strncpy(tokenbuf,s,d-s);
 		    if (strNE(tokenbuf,"keys") &&
 			strNE(tokenbuf,"values") &&
@@ -1138,7 +1158,8 @@ yylex()
 			strNE(tokenbuf,"readdir") &&
 			strNE(tokenbuf,"unpack") &&
 			strNE(tokenbuf,"do") &&
-			(d >= bufend || isspace(*d)) )
+			strNE(tokenbuf,"eval") &&
+			(d >= bufend || isSPACE(*d)) )
 			*(--s) = '\\';	/* force next ident to WORD */
 		}
 		LOP(O_SORT);
@@ -1176,17 +1197,23 @@ yylex()
 	    if (strEQ(d,"substr"))
 		FUN2x(O_SUBSTR);
 	    if (strEQ(d,"sub")) {
+		yylval.ival = savestack->ary_fill; /* restore stuff on reduce */
+		if (perldb) {
+		    savelong(&subline);
+		    saveitem(subname);
+		}
+
 		subline = curcmd->c_line;
 		d = bufend;
-		while (s < d && isspace(*s))
+		while (s < d && isSPACE(*s))
 		    s++;
-		if (isalpha(*s) || *s == '_' || *s == '\'') {
+		if (isALPHA(*s) || *s == '_' || *s == '\'') {
 		    if (perldb) {
 			str_sset(subname,curstname);
 			str_ncat(subname,"'",1);
-			for (d = s+1;
-			  isalpha(*d) || isdigit(*d) || *d == '_' || *d == '\'';
-			  d++);
+			for (d = s+1; isALNUM(*d) || *d == '\''; d++)
+			    /*SUPPRESS 530*/
+			    ;
 			if (d[-1] == '\'')
 			    d--;
 			str_ncat(subname,s,d-s);
@@ -1322,7 +1349,7 @@ yylex()
     yylval.cval = savestr(d);
     expectterm = FALSE;
     if (oldoldbufptr && oldoldbufptr < bufptr) {
-	while (isspace(*oldoldbufptr))
+	while (isSPACE(*oldoldbufptr))
 	    oldoldbufptr++;
 	if (*oldoldbufptr == 'p' && strnEQ(oldoldbufptr,"print",5))
 	    expectterm = TRUE;
@@ -1341,13 +1368,13 @@ char *what;
 
     if (*s == '(')
 	s++;
-    while (s < bufend && isascii(*s) && isspace(*s))
+    while (s < bufend && isSPACE(*s))
 	s++;
-    if (isascii(*s) && (isalpha(*s) || *s == '_')) {
+    if (isALPHA(*s) || *s == '_') {
 	someword = s++;
-	while (isalpha(*s) || isdigit(*s) || *s == '_')
+	while (isALNUM(*s))
 	    s++;
-	while (s < bufend && isspace(*s))
+	while (s < bufend && isSPACE(*s))
 	    s++;
 	if (*s == ',') {
 	    *s = '\0';
@@ -1375,12 +1402,12 @@ char *dest;
     reparse = Nullch;
     s++;
     d = dest;
-    if (isdigit(*s)) {
-	while (isdigit(*s))
+    if (isDIGIT(*s)) {
+	while (isDIGIT(*s))
 	    *d++ = *s++;
     }
     else {
-	while (isalpha(*s) || isdigit(*s) || *s == '_' || *s == '\'')
+	while (isALNUM(*s) || *s == '\'')
 	    *d++ = *s++;
     }
     while (d > dest+1 && d[-1] == '\'')
@@ -1393,8 +1420,7 @@ char *dest;
 	    d = dest;
 	    brackets++;
 	    while (s < send && brackets) {
-		if (!reparse && (d == dest || (*s && isascii(*s) &&
-		  (isalpha(*s) || isdigit(*s) || *s == '_') ))) {
+		if (!reparse && (d == dest || (*s && isALNUM(*s) ))) {
 		    *d++ = *s++;
 		    continue;
 		}
@@ -1418,18 +1444,23 @@ char *dest;
 	else
 	    d[1] = '\0';
     }
-    if (*d == '^' && (isupper(*s) || index("[\\]^_?",*s)))
+    if (*d == '^' && (isUPPER(*s) || index("[\\]^_?", *s))) {
+#ifdef DEBUGGING
+	if (*s == 'D')
+	    debug |= 32768;
+#endif
 	*d = *s++ ^ 64;
+    }
     return s;
 }
 
-STR *
+void
 scanconst(spat,string,len)
 SPAT *spat;
 char *string;
 int len;
 {
-    register STR *retstr;
+    register STR *tmpstr;
     register char *t;
     register char *d;
     register char *e;
@@ -1437,27 +1468,28 @@ int len;
     static char *vert = "|";
 
     if (ninstr(string, string+len, vert, vert+1))
-	return Nullstr;
+	return;
     if (*string == '^')
 	string++, len--;
-    retstr = Str_new(86,len);
-    str_nset(retstr,string,len);
-    t = str_get(retstr);
+    tmpstr = Str_new(86,len);
+    str_nset(tmpstr,string,len);
+    t = str_get(tmpstr);
     e = t + len;
-    retstr->str_u.str_useful = 100;
+    tmpstr->str_u.str_useful = 100;
     for (d=t; d < e; ) {
 	switch (*d) {
 	case '{':
-	    if (isdigit(d[1]))
+	    if (isDIGIT(d[1]))
 		e = d;
 	    else
 		goto defchar;
 	    break;
 	case '.': case '[': case '$': case '(': case ')': case '|': case '+':
+	case '^':
 	    e = d;
 	    break;
 	case '\\':
-	    if (d[1] && index("wWbB0123456789sSdDlLuUE",d[1])) {
+	    if (d[1] && index("wWbB0123456789sSdDlLuUExc",d[1])) {
 		e = d;
 		break;
 	    }
@@ -1494,18 +1526,17 @@ int len;
 	}
     }
     if (d == t) {
-	str_free(retstr);
-	return Nullstr;
+	str_free(tmpstr);
+	return;
     }
     *d = '\0';
-    retstr->str_cur = d - t;
+    tmpstr->str_cur = d - t;
     if (d == t+len)
 	spat->spat_flags |= SPAT_ALL;
     if (*origstring != '^')
 	spat->spat_flags |= SPAT_SCANFIRST;
-    spat->spat_short = retstr;
+    spat->spat_short = tmpstr;
     spat->spat_slen = d - t;
-    return retstr;
 }
 
 char *
@@ -1663,15 +1694,15 @@ register char *s;
 	    arg->arg_type = O_ITEM;
 	    arg[1].arg_type = A_DOUBLE;
 	    arg[1].arg_ptr.arg_str = str_smake(str);
-	    d = scanident(d,bufend,buf);
+	    d = scanident(d,e,buf);
 	    (void)stabent(buf,TRUE);		/* make sure it's created */
 	    for (; *d; d++) {
 		if (*d == '$' && d[1] && d[-1] != '\\' && d[1] != '|') {
-		    d = scanident(d,bufend,buf);
+		    d = scanident(d,e,buf);
 		    (void)stabent(buf,TRUE);
 		}
 		else if (*d == '@' && d[-1] != '\\') {
-		    d = scanident(d,bufend,buf);
+		    d = scanident(d,e,buf);
 		    if (strEQ(buf,"ARGV") || strEQ(buf,"ENV") ||
 		      strEQ(buf,"SIG") || strEQ(buf,"INC"))
 			(void)stabent(buf,TRUE);
@@ -1701,7 +1732,7 @@ get_repl:
 	e = tmpstr->str_ptr + tmpstr->str_cur;
 	for (t = tmpstr->str_ptr; t < e; t++) {
 	    if (*t == '$' && t[1] && (index("`'&+0123456789",t[1]) ||
-	      (t[1] == '{' /*}*/ && isdigit(t[2])) ))
+	      (t[1] == '{' /*}*/ && isDIGIT(t[2])) ))
 		spat->spat_flags &= ~SPAT_CONST;
 	}
     }
@@ -1710,7 +1741,9 @@ get_repl:
 	    s++;
 	    if ((spat->spat_repl[1].arg_type & A_MASK) == A_DOUBLE)
 		spat->spat_repl[1].arg_type = A_SINGLE;
-	    spat->spat_repl = make_op(O_EVAL,2,
+	    spat->spat_repl = make_op(
+		(spat->spat_repl[1].arg_type == A_SINGLE ? O_EVALONCE : O_EVAL),
+		2,
 		spat->spat_repl,
 		Nullarg,
 		Nullarg);
@@ -1950,6 +1983,9 @@ register char *s;
 		switch (*s) {
 		default:
 		    goto out;
+		case '_':
+		    s++;
+		    break;
 		case '8': case '9':
 		    if (shift != 4)
 			yyerror("Illegal octal digit");
@@ -1984,7 +2020,7 @@ register char *s;
       decimal:
 	arg[1].arg_type = A_SINGLE;
 	d = tokenbuf;
-	while (isdigit(*s) || *s == '_') {
+	while (isDIGIT(*s) || *s == '_') {
 	    if (*s == '_')
 		s++;
 	    else
@@ -1992,7 +2028,7 @@ register char *s;
 	}
 	if (*s == '.' && s[1] && index("0123456789eE ;",s[1])) {
 	    *d++ = *s++;
-	    while (isdigit(*s) || *s == '_') {
+	    while (isDIGIT(*s) || *s == '_') {
 		if (*s == '_')
 		    s++;
 		else
@@ -2003,7 +2039,7 @@ register char *s;
 	    *d++ = *s++;
 	    if (*s == '+' || *s == '-')
 		*d++ = *s++;
-	    while (isdigit(*s))
+	    while (isDIGIT(*s))
 		*d++ = *s++;
 	}
 	*d = '\0';
@@ -2034,7 +2070,7 @@ register char *s;
 		    s++, term = '\'';
 		else
 		    term = '"';
-		while (isascii(*s) && (isalpha(*s) || isdigit(*s) || *s == '_'))
+		while (isALNUM(*s))
 		    *d++ = *s++;
 	    }				/* assuming tokenbuf won't clobber */
 	    *d++ = '\n';
@@ -2057,8 +2093,7 @@ register char *s;
 	if (s < bufend)
 	    s++;
 	if (*d == '$') d++;
-	while (*d &&
-	  (isalpha(*d) || isdigit(*d) || *d == '_' || *d == '\''))
+	while (*d && (isALNUM(*d) || *d == '\''))
 	    d++;
 	if (d - tokenbuf != len) {
 	    d = tokenbuf;
@@ -2209,7 +2244,7 @@ register char *s;
 	    s = tmpstr->str_ptr;
 	    send = s + tmpstr->str_cur;
 	    while (s < send) {		/* see if we can make SINGLE */
-		if (*s == '\\' && s[1] && isdigit(s[1]) && !isdigit(s[2]) &&
+		if (*s == '\\' && s[1] && isDIGIT(s[1]) && !isDIGIT(s[2]) &&
 		  !alwaysdollar && s[1] != '0')
 		    *s = '$';		/* grandfather \digit in subst */
 		if ((*s == '$' || *s == '@') && s+1 < send &&
@@ -2228,6 +2263,8 @@ register char *s;
 		if ((*s == '$' && s+1 < send &&
 		    (alwaysdollar || /*(*/ (s[1] != ')' && s[1] != '|')) ) ||
 		    (*s == '@' && s+1 < send) ) {
+		    if (s[1] == '#' && (isALPHA(s[2]) || s[2] == '_'))
+			*d++ = *s++;
 		    len = scanident(s,send,tokenbuf) - s;
 		    if (*s == '$' || strEQ(tokenbuf,"ARGV")
 		      || strEQ(tokenbuf,"ENV")
@@ -2258,7 +2295,7 @@ register char *s;
 		    case 'c':
 			s++;
 			*d = *s++;
-			if (islower(*d))
+			if (isLOWER(*d))
 			    *d = toupper(*d);
 			*d++ ^= 64;
 			continue;
@@ -2337,6 +2374,7 @@ load_format()
 	    astore(stab_xarray(curcmd->c_filestab), (int)curcmd->c_line,tmpstr);
 	}
 	if (*s == '.') {
+	    /*SUPPRESS 530*/
 	    for (t = s+1; *t == ' ' || *t == '\t'; t++) ;
 	    if (*t == '\n') {
 		bufptr = s;
@@ -2479,7 +2517,7 @@ load_format()
 	    }
 	    else {
 		eol[-1] = '\n';
-		while (s < eol && isspace(*s))
+		while (s < eol && isSPACE(*s))
 		    s++;
 		t = s;
 		while (s < eol) {
@@ -2487,7 +2525,7 @@ load_format()
 		    case ' ': case '\t': case '\n': case ';':
 			str_ncat(str, t, s - t);
 			str_ncat(str, "," ,1);
-			while (s < eol && (isspace(*s) || *s == ';'))
+			while (s < eol && (isSPACE(*s) || *s == ';'))
 			    s++;
 			t = s;
 			break;
diff --git a/usub/usersub.c b/usub/usersub.c
index 559f9a4fa2..ffbfbe1552 100644
--- a/usub/usersub.c
+++ b/usub/usersub.c
@@ -1,6 +1,9 @@
-/* $Header: usersub.c,v 4.0 91/03/20 01:56:34 lwall Locked $
+/* $RCSfile: usersub.c,v $$Revision: 4.0.1.1 $$Date: 91/11/05 19:07:24 $
  *
  * $Log:	usersub.c,v $
+ * Revision 4.0.1.1  91/11/05  19:07:24  lwall
+ * patch11: there are now subroutines for calling back from C into Perl
+ * 
  * Revision 4.0  91/03/20  01:56:34  lwall
  * 4.0 baseline.
  * 
@@ -18,3 +21,52 @@ userinit()
     init_curses();
 }
 
+/* Be sure to refetch the stack pointer after calling these routines. */
+
+int
+callback(subname, sp, gimme, hasargs, numargs)
+char *subname;
+int sp;			/* stack pointer after args are pushed */
+int gimme;		/* called in array or scalar context */
+int hasargs;		/* whether to create a @_ array for routine */
+int numargs;		/* how many args are pushed on the stack */
+{
+    static ARG myarg[3];	/* fake syntax tree node */
+    int arglast[3];
+    
+    arglast[2] = sp;
+    sp -= numargs;
+    arglast[1] = sp--;
+    arglast[0] = sp;
+
+    if (!myarg[0].arg_ptr.arg_str)
+	myarg[0].arg_ptr.arg_str = str_make("",0);
+
+    myarg[1].arg_type = A_WORD;
+    myarg[1].arg_ptr.arg_stab = stabent(subname, FALSE);
+
+    myarg[2].arg_type = hasargs ? A_EXPR : A_NULL;
+
+    return do_subr(myarg, gimme, arglast);
+}
+
+int
+callv(subname, sp, gimme, argv)
+char *subname;
+register int sp;	/* current stack pointer */
+int gimme;		/* called in array or scalar context */
+register char **argv;	/* null terminated arg list, NULL for no arglist */
+{
+    register int items = 0;
+    int hasargs = (argv != 0);
+
+    astore(stack, ++sp, Nullstr);	/* reserve spot for 1st return arg */
+    if (hasargs) {
+	while (*argv) {
+	    astore(stack, ++sp, str_2mortal(str_make(*argv,0)));
+	    items++;
+	    argv++;
+	}
+    }
+    return callback(subname, sp, gimme, hasargs, items);
+}
diff --git a/util.c b/util.c
index af1a2b77ed..e55b2efc14 100644
--- a/util.c
+++ b/util.c
@@ -1,4 +1,4 @@
-/* $RCSfile: util.c,v $$Revision: 4.0.1.2 $$Date: 91/06/07 12:10:42 $
+/* $RCSfile: util.c,v $$Revision: 4.0.1.3 $$Date: 91/11/05 19:18:26 $
  *
  *    Copyright (c) 1991, Larry Wall
  *
@@ -6,6 +6,12 @@
  *    License or the Artistic License, as specified in the README file.
  *
  * $Log:	util.c,v $
+ * Revision 4.0.1.3  91/11/05  19:18:26  lwall
+ * patch11: safe malloc code now integrated into Perl's malloc when possible
+ * patch11: index("little", "longer string") could visit faraway places
+ * patch11: warn '-' x 10000 dumped core
+ * patch11: forked exec on non-existent program now issues a warning
+ * 
  * Revision 4.0.1.2  91/06/07  12:10:42  lwall
  * patch4: new copyright notice
  * patch4: made some allowances for "semi-standard" C
@@ -20,6 +26,7 @@
  * 4.0 baseline.
  * 
  */
+/*SUPPRESS 112*/
 
 #include "EXTERN.h"
 #include "perl.h"
@@ -45,6 +52,8 @@
 
 #define FLUSH
 
+#ifndef safemalloc
+
 static char nomem[] = "Out of memory!\n";
 
 /* paranoid version of malloc */
@@ -173,10 +182,13 @@ char *where;
 #  endif
 #endif
     if (where) {
+	/*SUPPRESS 701*/
 	free(where);
     }
 }
 
+#endif /* !safemalloc */
+
 #ifdef LEAKTEST
 
 #define ALIGN sizeof(long)
@@ -222,7 +234,7 @@ xstat()
     register int i;
 
     for (i = 0; i < MAXXCOUNT; i++) {
-	if (xcount[i] != lastxcount[i]) {
+	if (xcount[i] > lastxcount[i]) {
 	    fprintf(stderr,"%2d %2d\t%ld\n", i / 100, i % 100, xcount[i]);
 	    lastxcount[i] = xcount[i];
 	}
@@ -307,6 +319,8 @@ char *lend;
 
     if (!first && little > littleend)
 	return big;
+    if (bigend - big < littleend - little)
+	return Nullch;
     bigend -= littleend - little++;
     while (big <= bigend) {
 	if (*big++ != first)
@@ -433,8 +447,8 @@ int iflag;
 {
     register unsigned char *s;
     register unsigned char *table;
-    register int i;
-    register int len = str->str_cur;
+    register unsigned int i;
+    register unsigned int len = str->str_cur;
     int rarest = 0;
     unsigned int frequency = 256;
 
@@ -564,6 +578,7 @@ STR *littlestr;
     if (littlestr->str_pok & SP_CASEFOLD) {	/* case insensitive? */
 	if (s < bigend) {
 	  top1:
+	    /*SUPPRESS 560*/
 	    if (tmp = table[*s]) {
 #ifdef POINTERRIGOR
 		if (bigend - s > tmp) {
@@ -597,6 +612,7 @@ STR *littlestr;
     else {
 	if (s < bigend) {
 	  top2:
+	    /*SUPPRESS 560*/
 	    if (tmp = table[*s]) {
 #ifdef POINTERRIGOR
 		if (bigend - s > tmp) {
@@ -660,17 +676,82 @@ STR *littlestr;
     big = Null(unsigned char*);
 #endif
     bigend = big + bigstr->str_cur;
-    big -= previous;
     while (pos < previous) {
 #ifndef lint
 	if (!(pos += screamnext[pos]))
 #endif
 	    return Nullch;
     }
+#ifdef POINTERRIGOR
     if (littlestr->str_pok & SP_CASEFOLD) {	/* case insignificant? */
 	do {
-	    if (big[pos] != first && big[pos] != fold[first])
-		continue;
+#ifndef lint
+	    while (big[pos-previous] != first && big[pos-previous] != fold[first]
+	      && (pos += screamnext[pos]) )
+		/*SUPPRESS 530*/
+		;
+#endif
+	    for (x=big+pos+1-previous,s=little; s < littleend; /**/ ) {
+		if (x >= bigend)
+		    return Nullch;
+		if (*s++ != *x++ && fold[*(s-1)] != *(x-1)) {
+		    s--;
+		    break;
+		}
+	    }
+	    if (s == littleend)
+#ifndef lint
+		return (char *)(big+pos-previous);
+#else
+		return Nullch;
+#endif
+	} while (
+#ifndef lint
+		pos += screamnext[pos]	/* does this goof up anywhere? */
+#else
+		pos += screamnext[0]
+#endif
+	    );
+    }
+    else {
+	do {
+#ifndef lint
+	    while (big[pos-previous] != first && (pos += screamnext[pos]))
+		/*SUPPRESS 530*/
+		;
+#endif
+	    for (x=big+pos+1-previous,s=little; s < littleend; /**/ ) {
+		if (x >= bigend)
+		    return Nullch;
+		if (*s++ != *x++) {
+		    s--;
+		    break;
+		}
+	    }
+	    if (s == littleend)
+#ifndef lint
+		return (char *)(big+pos-previous);
+#else
+		return Nullch;
+#endif
+	} while (
+#ifndef lint
+		pos += screamnext[pos]
+#else
+		pos += screamnext[0]
+#endif
+	    );
+    }
+#else /* !POINTERRIGOR */
+    big -= previous;
+    if (littlestr->str_pok & SP_CASEFOLD) {	/* case insignificant? */
+	do {
+#ifndef lint
+	    while (big[pos] != first && big[pos] != fold[first]
+	      && (pos += screamnext[pos]) )
+		/*SUPPRESS 530*/
+		;
+#endif
 	    for (x=big+pos+1,s=little; s < littleend; /**/ ) {
 		if (x >= bigend)
 		    return Nullch;
@@ -695,8 +776,11 @@ STR *littlestr;
     }
     else {
 	do {
-	    if (big[pos] != first)
-		continue;
+#ifndef lint
+	    while (big[pos] != first && (pos += screamnext[pos]))
+		/*SUPPRESS 530*/
+		;
+#endif
 	    for (x=big+pos+1,s=little; s < littleend; /**/ ) {
 		if (x >= bigend)
 		    return Nullch;
@@ -719,6 +803,7 @@ STR *littlestr;
 #endif
 	    );
     }
+#endif /* POINTERRIGOR */
     return Nullch;
 }
 
@@ -774,10 +859,20 @@ char *pat;
 long a1, a2, a3, a4;
 {
     char *s;
+    int usermess = strEQ(pat,"%s");
+    STR *tmpstr;
 
     s = buf;
-    (void)sprintf(s,pat,a1,a2,a3,a4);
-    s += strlen(s);
+    if (usermess) {
+	tmpstr = str_mortal(&str_undef);
+	str_set(tmpstr, (char*)a1);
+	*s++ = tmpstr->str_ptr[tmpstr->str_cur-1];
+    }
+    else {
+	(void)sprintf(s,pat,a1,a2,a3,a4);
+	s += strlen(s);
+    }
+
     if (s[-1] != '\n') {
 	if (curcmd->c_line) {
 	    (void)sprintf(s," at %s line %ld",
@@ -793,7 +888,13 @@ long a1, a2, a3, a4;
 	    s += strlen(s);
 	}
 	(void)strcpy(s,".\n");
+	if (usermess)
+	    str_cat(tmpstr,buf+1);
     }
+    if (usermess)
+	return tmpstr->str_ptr;
+    else
+	return buf;
 }
 
 /*VARARGS1*/
@@ -804,10 +905,11 @@ long a1, a2, a3, a4;
     extern FILE *e_fp;
     extern char *e_tmpname;
     char *tmps;
+    char *message;
 
-    mess(pat,a1,a2,a3,a4);
+    message = mess(pat,a1,a2,a3,a4);
     if (in_eval) {
-	str_set(stab_val(stabent("@",TRUE)),buf);
+	str_set(stab_val(stabent("@",TRUE)),message);
 	tmps = "_EVAL_";
 	while (loop_ptr >= 0 && (!loop_stack[loop_ptr].loop_label ||
 	  strNE(tmps,loop_stack[loop_ptr].loop_label) )) {
@@ -831,7 +933,7 @@ long a1, a2, a3, a4;
 	}
 	longjmp(loop_stack[loop_ptr].loop_env, 1);
     }
-    fputs(buf,stderr);
+    fputs(message,stderr);
     (void)fflush(stderr);
     if (e_fp)
 	(void)UNLINK(e_tmpname);
@@ -844,8 +946,10 @@ warn(pat,a1,a2,a3,a4)
 char *pat;
 long a1, a2, a3, a4;
 {
-    mess(pat,a1,a2,a3,a4);
-    fputs(buf,stderr);
+    char *message;
+
+    message = mess(pat,a1,a2,a3,a4);
+    fputs(message,stderr);
 #ifdef LEAKTEST
 #ifdef DEBUGGING
     if (debug & 4096)
@@ -856,11 +960,14 @@ long a1, a2, a3, a4;
 }
 #else
 /*VARARGS0*/
+char *
 mess(args)
 va_list args;
 {
     char *pat;
     char *s;
+    STR *tmpstr;
+    int usermess;
 #ifndef HAS_VPRINTF
 #ifdef CHARVSPRINTF
     char *vsprintf();
@@ -869,15 +976,23 @@ va_list args;
 #endif
 #endif
 
-    s = buf;
 #ifdef lint
     pat = Nullch;
 #else
     pat = va_arg(args, char *);
 #endif
-    (void) vsprintf(s,pat,args);
+    s = buf;
+    usermess = strEQ(pat, "%s");
+    if (usermess) {
+	tmpstr = str_mortal(&str_undef);
+	str_set(tmpstr, va_arg(args, char *));
+	*s++ = tmpstr->str_ptr[tmpstr->str_cur-1];
+    }
+    else {
+	(void) vsprintf(s,pat,args);
+	s += strlen(s);
+    }
 
-    s += strlen(s);
     if (s[-1] != '\n') {
 	if (curcmd->c_line) {
 	    (void)sprintf(s," at %s line %ld",
@@ -893,7 +1008,14 @@ va_list args;
 	    s += strlen(s);
 	}
 	(void)strcpy(s,".\n");
+	if (usermess)
+	    str_cat(tmpstr,buf+1);
     }
+
+    if (usermess)
+	return tmpstr->str_ptr;
+    else
+	return buf;
 }
 
 /*VARARGS0*/
@@ -904,16 +1026,17 @@ va_dcl
     extern FILE *e_fp;
     extern char *e_tmpname;
     char *tmps;
+    char *message;
 
 #ifndef lint
     va_start(args);
 #else
     args = 0;
 #endif
-    mess(args);
+    message = mess(args);
     va_end(args);
     if (in_eval) {
-	str_set(stab_val(stabent("@",TRUE)),buf);
+	str_set(stab_val(stabent("@",TRUE)),message);
 	tmps = "_EVAL_";
 	while (loop_ptr >= 0 && (!loop_stack[loop_ptr].loop_label ||
 	  strNE(tmps,loop_stack[loop_ptr].loop_label) )) {
@@ -937,7 +1060,7 @@ va_dcl
 	}
 	longjmp(loop_stack[loop_ptr].loop_env, 1);
     }
-    fputs(buf,stderr);
+    fputs(message,stderr);
     (void)fflush(stderr);
     if (e_fp)
 	(void)UNLINK(e_tmpname);
@@ -950,16 +1073,17 @@ warn(va_alist)
 va_dcl
 {
     va_list args;
+    char *message;
 
 #ifndef lint
     va_start(args);
 #else
     args = 0;
 #endif
-    mess(args);
+    message = mess(args);
     va_end(args);
 
-    fputs(buf,stderr);
+    fputs(message,stderr);
 #ifdef LEAKTEST
 #ifdef DEBUGGING
     if (debug & 4096)
@@ -981,6 +1105,7 @@ char *nam, *val;
 	int max;
 	char **tmpenv;
 
+	/*SUPPRESS 530*/
 	for (max = i; environ[max]; max++) ;
 	New(901,tmpenv, max+2, char*);
 	for (j=0; j<max; j++)		/* copy environment */
@@ -1242,8 +1367,10 @@ char	*mode;
 		close(fd);
 #endif
 	    do_exec(cmd);	/* may or may not use the shell */
+	    warn("Can't exec \"%s\": %s", cmd, strerror(errno));
 	    _exit(1);
 	}
+	/*SUPPRESS 560*/
 	if (tmpstab = stabent("$",allstabs))
 	    str_numset(STAB_STR(tmpstab),(double)getpid());
 	forkprocess = 0;
@@ -1321,9 +1448,9 @@ FILE *ptr;
     int pid;
 
     str = afetch(fdpid,fileno(ptr),TRUE);
+    pid = (int)str->str_u.str_useful;
     astore(fdpid,fileno(ptr),Nullstr);
     fclose(ptr);
-    pid = (int)str->str_u.str_useful;
     hstat = signal(SIGHUP, SIG_IGN);
     istat = signal(SIGINT, SIG_IGN);
     qstat = signal(SIGQUIT, SIG_IGN);
@@ -1340,9 +1467,11 @@ int pid;
 int *statusp;
 int flags;
 {
+#if !defined(HAS_WAIT4) && !defined(HAS_WAITPID)
     int result;
     STR *str;
     char spid[16];
+#endif
 
     if (!pid)
 	return -1;
@@ -1387,6 +1516,7 @@ int flags;
 #endif
 }
 
+/*SUPPRESS 590*/
 pidgone(pid,status)
 int pid;
 int status;
diff --git a/util.h b/util.h
index 8d013ff62a..a712436ff6 100644
--- a/util.h
+++ b/util.h
@@ -1,4 +1,4 @@
-/* $RCSfile: util.h,v $$Revision: 4.0.1.1 $$Date: 91/06/07 12:11:00 $
+/* $RCSfile: util.h,v $$Revision: 4.0.1.2 $$Date: 91/11/05 19:18:40 $
  *
  *    Copyright (c) 1991, Larry Wall
  *
@@ -6,6 +6,9 @@
  *    License or the Artistic License, as specified in the README file.
  *
  * $Log:	util.h,v $
+ * Revision 4.0.1.2  91/11/05  19:18:40  lwall
+ * patch11: safe malloc code now integrated into Perl's malloc when possible
+ * 
  * Revision 4.0.1.1  91/06/07  12:11:00  lwall
  * patch4: new copyright notice
  * 
@@ -17,8 +20,10 @@
 EXT int *screamfirst INIT(Null(int*));
 EXT int *screamnext INIT(Null(int*));
 
+#ifndef safemalloc
 char	*safemalloc();
 char	*saferealloc();
+#endif
 char	*cpytill();
 char	*instr();
 char	*fbminstr();