X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=toke.c;h=709db636d1986ed5edcd125834c6e3213780330b;hb=7509b6572737d9774c4d9688c4edf46238aa95f2;hp=844b9829b36d9ed0e9722237494c120429896685;hpb=4810e5ece3e68c794a2f5f4b442ae6ee99d4998f;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/toke.c b/toke.c
index 844b982..709db63 100644
--- a/toke.c
+++ b/toke.c
@@ -1,6 +1,6 @@
 /*    toke.c
  *
- *    Copyright (c) 1991-1997, Larry Wall
+ *    Copyright (c) 1991-1999, Larry Wall
  *
  *    You may distribute under the terms of either the GNU General Public
  *    License or the Artistic License, as specified in the README file.
@@ -61,6 +61,22 @@ static void restore_lex_expect _((void *e));
 static char ident_too_long[] = "Identifier too long";
 
 #define UTF (PL_hints & HINT_UTF8)
+/*
+ * Note: we try to be careful never to call the isXXX_utf8() functions
+ * unless we're pretty sure we've seen the beginning of a UTF-8 character
+ * (that is, the two high bits are set).  Otherwise we risk loading in the
+ * heavy-duty SWASHINIT and SWASHGET routines unnecessarily.
+ */
+#define isIDFIRST_lazy(p) ((!UTF || (*((U8*)p) < 0xc0)) \
+				? isIDFIRST(*(p)) \
+				: isIDFIRST_utf8((U8*)p))
+#define isALNUM_lazy(p) ((!UTF || (*((U8*)p) < 0xc0)) \
+				? isALNUM(*(p)) \
+				: isALNUM_utf8((U8*)p))
+
+/* In variables name $^X, these are the legal values for X.  
+ * 1999-02-27 mjd-perl-patch@plover.com */
+#define isCONTROLVAR(x) (isUPPER(x) || strchr("[\\]^_?", (x)))
 
 /* The following are arranged oddly so that the guard on the switch statement
  * can get by with a single comparison (if the compiler is smart enough).
@@ -97,6 +113,18 @@ static char ident_too_long[] = "Identifier too long";
 #undef ff_next
 #endif
 
+#ifdef USE_PURE_BISON
+YYSTYPE* yylval_pointer = NULL;
+int* yychar_pointer = NULL;
+#  undef yylval
+#  undef yychar
+#  define yylval (*yylval_pointer)
+#  define yychar (*yychar_pointer)
+#  define PERL_YYLEX_PARAM yylval_pointer,yychar_pointer
+#else
+#  define PERL_YYLEX_PARAM
+#endif
+
 #include "keywords.h"
 
 #ifdef CLINE
@@ -167,14 +195,16 @@ no_op(char *what, char *s)
     yywarn(form("%s found where operator expected", what));
     if (is_first)
 	warn("\t(Missing semicolon on previous line?)\n");
-    else if (PL_oldoldbufptr && isIDFIRST(*PL_oldoldbufptr)) {
+    else if (PL_oldoldbufptr && isIDFIRST_lazy(PL_oldoldbufptr)) {
 	char *t;
-	for (t = PL_oldoldbufptr; *t && (isALNUM(*t) || *t == ':'); t++) ;
+	for (t = PL_oldoldbufptr; *t && (isALNUM_lazy(t) || *t == ':'); t++) ;
 	if (t < PL_bufptr && isSPACE(*t))
 	    warn("\t(Do you need to predeclare %.*s?)\n",
 		t - PL_oldoldbufptr, PL_oldoldbufptr);
 
     }
+    else if (s <= oldbp)
+	warn("\t(Missing operator before end of line?)\n");
     else
 	warn("\t(Missing operator before %.*s?)\n", s - oldbp, oldbp);
     PL_bufptr = oldbp;
@@ -333,7 +363,7 @@ lex_start(SV *line)
     PL_oldoldbufptr = PL_oldbufptr = PL_bufptr = PL_linestart = SvPVX(PL_linestr);
     PL_bufend = PL_bufptr + SvCUR(PL_linestr);
     SvREFCNT_dec(PL_rs);
-    PL_rs = newSVpv("\n", 1);
+    PL_rs = newSVpvn("\n", 1);
     PL_rsfp = 0;
 }
 
@@ -421,13 +451,20 @@ skipspace(register char *s)
     }
     for (;;) {
 	STRLEN prevlen;
-	while (s < PL_bufend && isSPACE(*s))
-	    s++;
+	while (s < PL_bufend && isSPACE(*s)) {
+	    if (*s++ == '\n' && PL_in_eval && !PL_rsfp)
+		incline(s);
+	}
 	if (s < PL_bufend && *s == '#') {
 	    while (s < PL_bufend && *s != '\n')
 		s++;
-	    if (s < PL_bufend)
+	    if (s < PL_bufend) {
 		s++;
+		if (PL_in_eval && !PL_rsfp) {
+		    incline(s);
+		    continue;
+		}
+	    }
 	}
 	if (s < PL_bufend || !PL_rsfp || PL_lex_state != LEX_NORMAL)
 	    return s;
@@ -476,7 +513,7 @@ check_uni(void) {
 	return;
     while (isSPACE(*PL_last_uni))
 	PL_last_uni++;
-    for (s = PL_last_uni; isALNUM(*s) || *s == '-'; s++) ;
+    for (s = PL_last_uni; isALNUM_lazy(s) || *s == '-'; s++) ;
     if ((t = strchr(s, '(')) && t < PL_bufptr)
 	return;
     ch = *s;
@@ -552,7 +589,7 @@ force_word(register char *start, int token, int check_keyword, int allow_pack, i
     
     start = skipspace(start);
     s = start;
-    if (isIDFIRST(*s) ||
+    if (isIDFIRST_lazy(s) ||
 	(allow_pack && *s == ':') ||
 	(allow_initial_tick && *s == '\'') )
     {
@@ -565,8 +602,6 @@ force_word(register char *start, int token, int check_keyword, int allow_pack, i
 		PL_expect = XTERM;
 	    else {
 		PL_expect = XOPERATOR;
-		force_next(')');
-		force_next('(');
 	    }
 	}
 	PL_nextval[PL_nexttoke].opval = (OP*)newSVOP(OP_CONST,0, newSVpv(PL_tokenbuf,0));
@@ -648,7 +683,7 @@ tokeq(SV *sv)
 	goto finish;
     d = s;
     if ( PL_hints & HINT_NEW_STRING )
-	pv = sv_2mortal(newSVpv(SvPVX(pv), len));
+	pv = sv_2mortal(newSVpvn(SvPVX(pv), len));
     while (s < send) {
 	if (*s == '\\') {
 	    if (s + 1 < send && (s[1] == '\\'))
@@ -684,7 +719,7 @@ sublex_start(void)
 	    SV *nsv;
 
 	    p = SvPV(sv, len);
-	    nsv = newSVpv(p, len);
+	    nsv = newSVpvn(p, len);
 	    SvREFCNT_dec(sv);
 	    sv = nsv;
 	} 
@@ -766,13 +801,13 @@ sublex_done(void)
 {
     if (!PL_lex_starts++) {
 	PL_expect = XOPERATOR;
-	yylval.opval = (OP*)newSVOP(OP_CONST, 0, newSVpv("",0));
+	yylval.opval = (OP*)newSVOP(OP_CONST, 0, newSVpvn("",0));
 	return THING;
     }
 
     if (PL_lex_casemods) {		/* oops, we've got some unbalanced parens */
 	PL_lex_state = LEX_INTERPCASEMOD;
-	return yylex();
+	return yylex(PERL_YYLEX_PARAM);
     }
 
     /* Is there a right-hand side to take care of? */
@@ -791,10 +826,15 @@ sublex_done(void)
 	if (SvCOMPILED(PL_lex_repl)) {
 	    PL_lex_state = LEX_INTERPNORMAL;
 	    PL_lex_starts++;
+	    /*	we don't clear PL_lex_repl here, so that we can check later
+		whether this is an evalled subst; that means we rely on the
+		logic to ensure sublex_done() is called again only via the
+		branch (in yylex()) that clears PL_lex_repl, else we'll loop */
 	}
-	else
+	else {
 	    PL_lex_state = LEX_INTERPCONCAT;
-	PL_lex_repl = Nullsv;
+	    PL_lex_repl = Nullsv;
+	}
 	return ',';
     }
     else {
@@ -888,10 +928,10 @@ scan_const(char *start)
     register char *d = SvPVX(sv);		/* destination for copies */
     bool dorange = FALSE;			/* are we in a translit range? */
     I32 len;					/* ? */
-    I32 utf = PL_lex_inwhat == OP_TRANS
+    I32 utf = (PL_lex_inwhat == OP_TRANS && PL_sublex_info.sub_op)
 	? (PL_sublex_info.sub_op->op_private & (OPpTRANS_FROM_UTF|OPpTRANS_TO_UTF))
 	: UTF;
-    I32 thisutf = PL_lex_inwhat == OP_TRANS
+    I32 thisutf = (PL_lex_inwhat == OP_TRANS && PL_sublex_info.sub_op)
 	? (PL_sublex_info.sub_op->op_private & (PL_lex_repl ? OPpTRANS_FROM_UTF : OPpTRANS_TO_UTF))
 	: UTF;
 
@@ -976,8 +1016,10 @@ scan_const(char *start)
 			count--;
 		    regparse++;
 		}
-		if (*regparse != ')')
+		if (*regparse != ')') {
+		    regparse--;		/* Leave one char for continuation. */
 		    yyerror("Sequence (?{...}) not terminated or not {}-balanced");
+		}
 		while (s < regparse)
 		    *d++ = *s++;
 	    }
@@ -991,7 +1033,7 @@ scan_const(char *start)
 	}
 
 	/* check for embedded arrays (@foo, @:foo, @'foo, @{foo}, @$foo) */
-	else if (*s == '@' && s[1] && (isALNUM(s[1]) || strchr(":'{$", s[1])))
+	else if (*s == '@' && s[1] && (isALNUM_lazy(s+1) || strchr(":'{$", s[1])))
 	    break;
 
 	/* check for embedded scalars.  only stop if we're sure it's a
@@ -1023,7 +1065,7 @@ scan_const(char *start)
 	    s++;
 
 	    /* some backslashes we leave behind */
-	    if (*s && strchr(leaveit, *s)) {
+	    if (*leaveit && *s && strchr(leaveit, *s)) {
 		*d++ = '\\';
 		*d++ = *s++;
 		continue;
@@ -1056,10 +1098,17 @@ scan_const(char *start)
 		    continue;
 		}
 		/* FALL THROUGH */
-	    /* default action is to copy the quoted character */
 	    default:
-		*d++ = *s++;
-		continue;
+	        {
+		    dTHR;
+		    if (ckWARN(WARN_UNSAFE) && isALPHA(*s))
+			warner(WARN_UNSAFE, 
+			       "Unrecognized escape \\%c passed through",
+			       *s);
+		    /* default action is to copy the quoted character */
+		    *d++ = *s++;
+		    continue;
+		}
 
 	    /* \132 indicates an octal constant */
 	    case '0': case '1': case '2': case '3':
@@ -1074,8 +1123,10 @@ scan_const(char *start)
 		if (*s == '{') {
 		    char* e = strchr(s, '}');
 
-		    if (!e)
+		    if (!e) {
 			yyerror("Missing right brace on \\x{}");
+			e = s;
+		    }
 		    if (!utf) {
 			dTHR;
 			if (ckWARN(WARN_UTF8))
@@ -1245,7 +1296,7 @@ intuit_more(register char *s)
 	    case '&':
 	    case '$':
 		weight -= seen[un_char] * 10;
-		if (isALNUM(s[1])) {
+		if (isALNUM_lazy(s+1)) {
 		    scan_ident(s, send, tmpbuf, sizeof tmpbuf, FALSE);
 		    if ((int)strlen(tmpbuf) > 1 && gv_fetchpv(tmpbuf,FALSE, SVt_PV))
 			weight -= 100;
@@ -1360,7 +1411,7 @@ intuit_method(char *start, GV *gv)
 		return 0;	/* no assumptions -- "=>" quotes bearword */
       bare_package:
 	    PL_nextval[PL_nexttoke].opval = (OP*)newSVOP(OP_CONST, 0,
-						   newSVpv(tmpbuf,0));
+						   newSVpvn(tmpbuf,len));
 	    PL_nextval[PL_nexttoke].opval->op_private = OPpCONST_BARE;
 	    PL_expect = XTERM;
 	    force_next(WORD);
@@ -1401,13 +1452,12 @@ incl_perldb(void)
  * Note that IoTOP_NAME, IoFMT_NAME, IoBOTTOM_NAME, if set for
  * private use must be set using malloc'd pointers.
  */
-static int filter_debug = 0;
 
 SV *
 filter_add(filter_t funcp, SV *datasv)
 {
     if (!funcp){ /* temporary handy debugging hack to be deleted */
-	filter_debug = atoi((char*)datasv);
+	PL_filter_debug = atoi((char*)datasv);
 	return NULL;
     }
     if (!PL_rsfp_filters)
@@ -1417,8 +1467,10 @@ filter_add(filter_t funcp, SV *datasv)
     if (!SvUPGRADE(datasv, SVt_PVIO))
         die("Can't upgrade filter_add data to SVt_PVIO");
     IoDIRP(datasv) = (DIR*)funcp; /* stash funcp into spare field */
-    if (filter_debug)
-	warn("filter_add func %p (%s)", funcp, SvPV(datasv,PL_na));
+    if (PL_filter_debug) {
+	STRLEN n_a;
+	warn("filter_add func %p (%s)", funcp, SvPV(datasv, n_a));
+    }
     av_unshift(PL_rsfp_filters, 1);
     av_store(PL_rsfp_filters, 0, datasv) ;
     return(datasv);
@@ -1429,7 +1481,7 @@ filter_add(filter_t funcp, SV *datasv)
 void
 filter_del(filter_t funcp)
 {
-    if (filter_debug)
+    if (PL_filter_debug)
 	warn("filter_del func %p", funcp);
     if (!PL_rsfp_filters || AvFILLp(PL_rsfp_filters)<0)
 	return;
@@ -1459,7 +1511,7 @@ filter_read(int idx, SV *buf_sv, int maxlen)
     if (idx > AvFILLp(PL_rsfp_filters)){       /* Any more filters?	*/
 	/* Provide a default input filter to make life easy.	*/
 	/* Note that we append to the line. This is handy.	*/
-	if (filter_debug)
+	if (PL_filter_debug)
 	    warn("filter_read %d: from rsfp\n", idx);
 	if (maxlen) { 
  	    /* Want a block */
@@ -1488,15 +1540,17 @@ filter_read(int idx, SV *buf_sv, int maxlen)
     }
     /* Skip this filter slot if filter has been deleted	*/
     if ( (datasv = FILTER_DATA(idx)) == &PL_sv_undef){
-	if (filter_debug)
+	if (PL_filter_debug)
 	    warn("filter_read %d: skipped (filter deleted)\n", idx);
 	return FILTER_READ(idx+1, buf_sv, maxlen); /* recurse */
     }
     /* Get function pointer hidden within datasv	*/
     funcp = (filter_t)IoDIRP(datasv);
-    if (filter_debug)
+    if (PL_filter_debug) {
+	STRLEN n_a;
 	warn("filter_read %d: via function %p (%s)\n",
-		idx, funcp, SvPV(datasv,PL_na));
+		idx, funcp, SvPV(datasv,n_a));
+    }
     /* Call function. The function is expected to 	*/
     /* call "FILTER_READ(idx+1, buf_sv)" first.		*/
     /* Return: <0:error, =0:eof, >0:not eof 		*/
@@ -1530,8 +1584,6 @@ filter_gets(register SV *sv, register PerlIO *fp, STRLEN append)
 	{ "OPERATOR", "TERM", "REF", "STATE", "BLOCK", "TERMBLOCK" };
 #endif
 
-EXT int yychar;		/* last token */
-
 /*
   yylex
 
@@ -1557,8 +1609,7 @@ EXT int yychar;		/* last token */
       if we already built the token before, use it.
 */
 
-int
-yylex(void)
+int yylex(PERL_YYLEX_PARAM_DECL)
 {
     dTHR;
     register char *s;
@@ -1568,6 +1619,11 @@ yylex(void)
     GV *gv = Nullgv;
     GV **gvp = 0;
 
+#ifdef USE_PURE_BISON
+    yylval_pointer = lvalp;
+    yychar_pointer = lcharp;
+#endif
+
     /* check if there's an identifier for us to look at */
     if (PL_pending_ident) {
         /* pit holds the identifier we read and pending_ident is reset */
@@ -1582,7 +1638,7 @@ yylex(void)
 	*/
 	if (PL_in_my) {
 	    if (strchr(PL_tokenbuf,':'))
-		croak(no_myglob,PL_tokenbuf);
+		yyerror(form(PL_no_myglob,PL_tokenbuf));
 
 	    yylval.opval = newOP(OP_PADANY, 0);
 	    yylval.opval->op_targ = pad_allocmy(PL_tokenbuf);
@@ -1705,7 +1761,7 @@ yylex(void)
 	    if (PL_bufptr != PL_bufend)
 		PL_bufptr += 2;
 	    PL_lex_state = LEX_INTERPCONCAT;
-	    return yylex();
+	    return yylex(PERL_YYLEX_PARAM);
 	}
 	else {
 	    s = PL_bufptr + 1;
@@ -1749,7 +1805,7 @@ yylex(void)
 		Aop(OP_CONCAT);
 	    }
 	    else
-		return yylex();
+		return yylex(PERL_YYLEX_PARAM);
 	}
 
     case LEX_INTERPPUSH:
@@ -1782,7 +1838,7 @@ yylex(void)
 	    s = PL_bufptr;
 	    Aop(OP_CONCAT);
 	}
-	return yylex();
+	return yylex(PERL_YYLEX_PARAM);
 
     case LEX_INTERPENDMAYBE:
 	if (intuit_more(PL_bufptr)) {
@@ -1797,6 +1853,13 @@ yylex(void)
 	    PL_lex_state = LEX_INTERPCONCAT;
 	    return ')';
 	}
+	if (PL_lex_inwhat == OP_SUBST && PL_linestr == PL_lex_repl
+	    && SvCOMPILED(PL_lex_repl))
+	{
+	    if (PL_bufptr != PL_bufend)
+		croak("Bad evalled substitution pattern");
+	    PL_lex_repl = Nullsv;
+	}
 	/* FALLTHROUGH */
     case LEX_INTERPCONCAT:
 #ifdef DEBUGGING
@@ -1831,11 +1894,11 @@ yylex(void)
 		Aop(OP_CONCAT);
 	    else {
 		PL_bufptr = s;
-		return yylex();
+		return yylex(PERL_YYLEX_PARAM);
 	    }
 	}
 
-	return yylex();
+	return yylex(PERL_YYLEX_PARAM);
     case LEX_FORMLINE:
 	PL_lex_state = LEX_NORMAL;
 	s = scan_formline(PL_bufptr);
@@ -1854,16 +1917,8 @@ yylex(void)
   retry:
     switch (*s) {
     default:
-	/*
-	 * Note: we try to be careful never to call the isXXX_utf8() functions unless we're
-	 * pretty sure we've seen the beginning of a UTF-8 character (that is, the two high
-	 * bits are set).  Otherwise we risk loading in the heavy-duty SWASHINIT and SWASHGET
-	 * routines unnecessarily.  You will see this not just here but throughout this file.
-	 */
-	if (UTF && (*s & 0xc0) == 0x80) {
-	    if (isIDFIRST_utf8((U8*)s))
-		goto keylookup;
-	}
+	if (isIDFIRST_lazy(s))
+	    goto keylookup;
 	croak("Unrecognized character \\x%02X", *s & 255);
     case 4:
     case 26:
@@ -1873,7 +1928,7 @@ yylex(void)
 	    PL_last_uni = 0;
 	    PL_last_lop = 0;
 	    if (PL_lex_brackets)
-		yyerror("Missing right bracket");
+		yyerror("Missing right curly or square bracket");
 	    TOKEN(0);
 	}
 	if (s++ < PL_bufend)
@@ -2082,7 +2137,7 @@ yylex(void)
 		    else
 			newargv = PL_origargv;
 		    newargv[0] = ipath;
-		    execv(ipath, newargv);
+		    PerlProc_execv(ipath, newargv);
 		    croak("Can't exec %s", ipath);
 		}
 		if (d) {
@@ -2123,7 +2178,7 @@ yylex(void)
 	if (PL_lex_formbrack && PL_lex_brackets <= PL_lex_formbrack) {
 	    PL_bufptr = s;
 	    PL_lex_state = LEX_FORMLINE;
-	    return yylex();
+	    return yylex(PERL_YYLEX_PARAM);
 	}
 	goto retry;
     case '\r':
@@ -2147,7 +2202,7 @@ yylex(void)
 	    if (PL_lex_formbrack && PL_lex_brackets <= PL_lex_formbrack) {
 		PL_bufptr = s;
 		PL_lex_state = LEX_FORMLINE;
-		return yylex();
+		return yylex(PERL_YYLEX_PARAM);
 	    }
 	}
 	else {
@@ -2214,7 +2269,7 @@ yylex(void)
 	else if (*s == '>') {
 	    s++;
 	    s = skipspace(s);
-	    if (isIDFIRST(*s)) {
+	    if (isIDFIRST_lazy(s)) {
 		s = force_word(s,METHOD,FALSE,TRUE,FALSE);
 		TOKEN(ARROW);
 	    }
@@ -2317,7 +2372,7 @@ yylex(void)
     case ']':
 	s++;
 	if (PL_lex_brackets <= 0)
-	    yyerror("Unmatched right bracket");
+	    yyerror("Unmatched right square bracket");
 	else
 	    --PL_lex_brackets;
 	if (PL_lex_state == LEX_INTERPNORMAL) {
@@ -2359,7 +2414,7 @@ yylex(void)
 		while (d < PL_bufend && (*d == ' ' || *d == '\t'))
 		    d++;
 	    }
-	    if (d < PL_bufend && isIDFIRST(*d)) {
+	    if (d < PL_bufend && isIDFIRST_lazy(d)) {
 		d = scan_word(d, PL_tokenbuf + 1, sizeof PL_tokenbuf - 1,
 			      FALSE, &len);
 		while (d < PL_bufend && (*d == ' ' || *d == '\t'))
@@ -2447,8 +2502,8 @@ yylex(void)
 		    }
 		    t++;
 		}
-		else if (isALPHA(*s)) {
-		    for (t++; t < PL_bufend && isALNUM(*t); t++) ;
+		else if (isIDFIRST_lazy(s)) {
+		    for (t++; t < PL_bufend && isALNUM_lazy(t); t++) ;
 		}
 		while (t < PL_bufend && isSPACE(*t))
 		    t++;
@@ -2458,7 +2513,7 @@ yylex(void)
 				   || (*t == '=' && t[1] == '>')))
 		    OPERATOR(HASHBRACK);
 		if (PL_expect == XREF)
-		    PL_expect = XTERM;
+		    PL_expect = XSTATE;	/* was XTERM, trying XSTATE */
 		else {
 		    PL_lex_brackstack[PL_lex_brackets-1] = XSTATE;
 		    PL_expect = XSTATE;
@@ -2474,7 +2529,7 @@ yylex(void)
       rightbracket:
 	s++;
 	if (PL_lex_brackets <= 0)
-	    yyerror("Unmatched right bracket");
+	    yyerror("Unmatched right curly bracket");
 	else
 	    PL_expect = (expectation)PL_lex_brackstack[--PL_lex_brackets];
 	if (PL_lex_brackets < PL_lex_formbrack)
@@ -2484,7 +2539,7 @@ yylex(void)
 		if (PL_lex_fakebrack) {
 		    PL_lex_state = LEX_INTERPEND;
 		    PL_bufptr = s;
-		    return yylex();		/* ignore fake brackets */
+		    return yylex(PERL_YYLEX_PARAM);	/* ignore fake brackets */
 		}
 		if (*s == '-' && s[1] == '>')
 		    PL_lex_state = LEX_INTERPENDMAYBE;
@@ -2495,7 +2550,7 @@ yylex(void)
 	if (PL_lex_brackets < PL_lex_fakebrack) {
 	    PL_bufptr = s;
 	    PL_lex_fakebrack = 0;
-	    return yylex();		/* ignore fake brackets */
+	    return yylex(PERL_YYLEX_PARAM);		/* ignore fake brackets */
 	}
 	force_next('}');
 	TOKEN(';');
@@ -2506,9 +2561,9 @@ yylex(void)
 	    AOPERATOR(ANDAND);
 	s--;
 	if (PL_expect == XOPERATOR) {
-	    if (ckWARN(WARN_SEMICOLON) && isALPHA(*s) && PL_bufptr == PL_linestart) {
+	    if (ckWARN(WARN_SEMICOLON) && isIDFIRST_lazy(s) && PL_bufptr == PL_linestart) {
 		PL_curcop->cop_line--;
-		warner(WARN_SEMICOLON, warn_nosemi);
+		warner(WARN_SEMICOLON, PL_warn_nosemi);
 		PL_curcop->cop_line++;
 	    }
 	    BAop(OP_BIT_AND);
@@ -2636,7 +2691,7 @@ yylex(void)
 	    }
 	}
 
-	if (s[1] == '#' && (isALPHA(s[2]) || strchr("_{$:+-", s[2]))) {
+	if (s[1] == '#' && (isIDFIRST_lazy(s+2) || strchr("{$:+-", s[2]))) {
 	    if (PL_expect == XOPERATOR)
 		no_op("Array length", PL_bufptr);
 	    PL_tokenbuf[0] = '@';
@@ -2668,6 +2723,7 @@ yylex(void)
 	}
 
 	d = s;
+	tmp = (I32)*s;
 	if (PL_lex_state == LEX_NORMAL)
 	    s = skipspace(s);
 
@@ -2677,7 +2733,7 @@ yylex(void)
 		PL_tokenbuf[0] = '@';
 		if (ckWARN(WARN_SYNTAX)) {
 		    for(t = s + 1;
-			isSPACE(*t) || isALNUM(*t) || *t == '$';
+			isSPACE(*t) || isALNUM_lazy(t) || *t == '$';
 			t++) ;
 		    if (*t++ == ',') {
 			PL_bufptr = skipspace(PL_bufptr);
@@ -2697,9 +2753,10 @@ yylex(void)
 		    char tmpbuf[sizeof PL_tokenbuf];
 		    STRLEN len;
 		    for (t++; isSPACE(*t); t++) ;
-		    if (isIDFIRST(*t)) {
+		    if (isIDFIRST_lazy(t)) {
 			t = scan_word(t, tmpbuf, sizeof tmpbuf, TRUE, &len);
-			if (*t != '(' && perl_get_cv(tmpbuf, FALSE))
+		        for (; isSPACE(*t); t++) ;
+			if (*t == ';' && perl_get_cv(tmpbuf, FALSE))
 			    warner(WARN_SYNTAX,
 				"You need to quote \"%s\"", tmpbuf);
 		    }
@@ -2708,15 +2765,15 @@ yylex(void)
 	}
 
 	PL_expect = XOPERATOR;
-	if (PL_lex_state == LEX_NORMAL && isSPACE(*d)) {
+	if (PL_lex_state == LEX_NORMAL && isSPACE((char)tmp)) {
 	    bool islop = (PL_last_lop == PL_oldoldbufptr);
 	    if (!islop || PL_last_lop_op == OP_GREPSTART)
 		PL_expect = XOPERATOR;
 	    else if (strchr("$@\"'`q", *s))
 		PL_expect = XTERM;		/* e.g. print $fh "foo" */
-	    else if (strchr("&*<%", *s) && isIDFIRST(s[1]))
+	    else if (strchr("&*<%", *s) && isIDFIRST_lazy(s+1))
 		PL_expect = XTERM;		/* e.g. print $fh &sub */
-	    else if (isIDFIRST(*s)) {
+	    else if (isIDFIRST_lazy(s)) {
 		char tmpbuf[sizeof PL_tokenbuf];
 		scan_word(s, tmpbuf, sizeof tmpbuf, TRUE, &len);
 		if (tmp = keyword(tmpbuf, len)) {
@@ -2746,9 +2803,9 @@ yylex(void)
 		PL_expect = XTERM;		/* e.g. print $fh 3 */
 	    else if (*s == '.' && isDIGIT(s[1]))
 		PL_expect = XTERM;		/* e.g. print $fh .3 */
-	    else if (strchr("/?-+", *s) && !isSPACE(s[1]))
+	    else if (strchr("/?-+", *s) && !isSPACE(s[1]) && s[1] != '=')
 		PL_expect = XTERM;		/* e.g. print $fh -1 */
-	    else if (*s == '<' && s[1] == '<' && !isSPACE(s[2]))
+	    else if (*s == '<' && s[1] == '<' && !isSPACE(s[2]) && s[2] != '=')
 		PL_expect = XTERM;		/* print $fh <<"EOF" */
 	}
 	PL_pending_ident = '$';
@@ -2774,7 +2831,7 @@ yylex(void)
 	    if (ckWARN(WARN_SYNTAX)) {
 		if (*s == '[' || *s == '{') {
 		    char *t = s + 1;
-		    while (*t && (isALNUM(*t) || strchr(" \t$#+-'\"", *t)))
+		    while (*t && (isALNUM_lazy(t) || strchr(" \t$#+-'\"", *t)))
 			t++;
 		    if (*t == '}' || *t == ']') {
 			t++;
@@ -2795,7 +2852,7 @@ yylex(void)
 	    /* Disable warning on "study /blah/" */
 	    if (PL_oldoldbufptr == PL_last_uni 
 		&& (*PL_last_uni != 's' || s - PL_last_uni < 5 
-		    || memNE(PL_last_uni, "study", 5) || isALNUM(PL_last_uni[5])))
+		    || memNE(PL_last_uni, "study", 5) || isALNUM_lazy(PL_last_uni+5)))
 		check_uni();
 	    s = scan_pat(s,OP_MATCH);
 	    TERM(sublex_start());
@@ -2935,6 +2992,7 @@ yylex(void)
     case 'z': case 'Z':
 
       keylookup: {
+	STRLEN n_a;
 	gv = Nullgv;
 	gvp = 0;
 
@@ -3040,7 +3098,7 @@ yylex(void)
 		if (PL_expect == XOPERATOR) {
 		    if (PL_bufptr == PL_linestart) {
 			PL_curcop->cop_line--;
-			warner(WARN_SEMICOLON, warn_nosemi);
+			warner(WARN_SEMICOLON, PL_warn_nosemi);
 			PL_curcop->cop_line++;
 		    }
 		    else
@@ -3072,7 +3130,7 @@ yylex(void)
 		/* if we saw a global override before, get the right name */
 
 		if (gvp) {
-		    sv = newSVpv("CORE::GLOBAL::",14);
+		    sv = newSVpvn("CORE::GLOBAL::",14);
 		    sv_catpv(sv,PL_tokenbuf);
 		}
 		else
@@ -3096,7 +3154,7 @@ yylex(void)
 		    (PL_oldoldbufptr == PL_last_lop || PL_oldoldbufptr == PL_last_uni) &&
 		    /* NO SKIPSPACE BEFORE HERE! */
 		    (PL_expect == XREF 
-		     || ((opargs[PL_last_lop_op] >> OASHIFT)& 7) == OA_FILEREF
+		     || ((PL_opargs[PL_last_lop_op] >> OASHIFT)& 7) == OA_FILEREF
 		     || (PL_last_lop_op == OP_ENTERSUB 
 			 && PL_last_proto 
 			 && PL_last_proto[PL_last_proto[0] == ';' ? 1 : 0] == '*')) )
@@ -3108,7 +3166,7 @@ yylex(void)
 
 		    /* Two barewords in a row may indicate method call. */
 
-		    if ((isALPHA(*s) || *s == '$') && (tmp=intuit_method(s,gv)))
+		    if ((isIDFIRST_lazy(s) || *s == '$') && (tmp=intuit_method(s,gv)))
 			return tmp;
 
 		    /* If not a declared subroutine, it's an indirect object. */
@@ -3129,8 +3187,11 @@ yylex(void)
 		if (*s == '(') {
 		    CLINE;
 		    if (gv && GvCVu(gv)) {
+			CV *cv;
+			if ((cv = GvCV(gv)) && SvPOK(cv))
+			    PL_last_proto = SvPV((SV*)cv, n_a);
 			for (d = s + 1; *d == ' ' || *d == '\t'; d++) ;
-			if (*d == ')' && (sv = cv_const_sv(GvCV(gv)))) {
+			if (*d == ')' && (sv = cv_const_sv(cv))) {
 			    s = d + 1;
 			    goto its_constant;
 			}
@@ -3139,6 +3200,7 @@ yylex(void)
 		    PL_expect = XOPERATOR;
 		    force_next(WORD);
 		    yylval.ival = 0;
+		    PL_last_lop_op = OP_ENTERSUB;
 		    TOKEN('&');
 		}
 
@@ -3152,7 +3214,7 @@ yylex(void)
 
 		/* If followed by a bareword, see if it looks like indir obj. */
 
-		if ((isALPHA(*s) || *s == '$') && (tmp = intuit_method(s,gv)))
+		if ((isIDFIRST_lazy(s) || *s == '$') && (tmp = intuit_method(s,gv)))
 		    return tmp;
 
 		/* Not a method, so call it a subroutine (if defined) */
@@ -3177,6 +3239,7 @@ yylex(void)
 		    /* Resolve to GV now. */
 		    op_free(yylval.opval);
 		    yylval.opval = newCVREF(0, newGVOP(OP_GV, 0, gv));
+		    PL_last_lop_op = OP_ENTERSUB;
 		    /* Is there a prototype? */
 		    if (SvPOK(cv)) {
 			STRLEN len;
@@ -3203,7 +3266,10 @@ yylex(void)
 		    PL_last_lop_op != OP_TRUNCATE &&  /* S/F prototype in opcode.pl */
 		    PL_last_lop_op != OP_ACCEPT &&
 		    PL_last_lop_op != OP_PIPE_OP &&
-		    PL_last_lop_op != OP_SOCKPAIR)
+		    PL_last_lop_op != OP_SOCKPAIR &&
+		    !(PL_last_lop_op == OP_ENTERSUB 
+			 && PL_last_proto 
+			 && PL_last_proto[PL_last_proto[0] == ';' ? 1 : 0] == '*'))
 		{
 		    warn(
 		     "Bareword \"%s\" not allowed while \"strict subs\" in use",
@@ -3218,7 +3284,7 @@ yylex(void)
 		    if (lastchar != '-') {
 			for (d = PL_tokenbuf; *d && isLOWER(*d); d++) ;
 			if (!*d)
-			    warner(WARN_RESERVED, warn_reserved, PL_tokenbuf);
+			    warner(WARN_RESERVED, PL_warn_reserved, PL_tokenbuf);
 		    }
 		}
 
@@ -3466,13 +3532,13 @@ yylex(void)
 	case KEY_foreach:
 	    yylval.ival = PL_curcop->cop_line;
 	    s = skipspace(s);
-	    if (PL_expect == XSTATE && isIDFIRST(*s)) {
+	    if (PL_expect == XSTATE && isIDFIRST_lazy(s)) {
 		char *p = s;
 		if ((PL_bufend - p) >= 3 &&
 		    strnEQ(p, "my", 2) && isSPACE(*(p + 2)))
 		    p += 2;
 		p = skipspace(p);
-		if (isIDFIRST(*p))
+		if (isIDFIRST_lazy(p))
 		    croak("Missing $ on loop variable");
 	    }
 	    OPERATOR(FOR);
@@ -3660,7 +3726,7 @@ yylex(void)
 	    TERM(sublex_start());
 
 	case KEY_map:
-	    LOP(OP_MAPSTART,XREF);
+	    LOP(OP_MAPSTART, XREF);
 	    
 	case KEY_mkdir:
 	    LOP(OP_MKDIR,XTERM);
@@ -3680,7 +3746,7 @@ yylex(void)
 	case KEY_my:
 	    PL_in_my = TRUE;
 	    s = skipspace(s);
-	    if (isIDFIRST(*s)) {
+	    if (isIDFIRST_lazy(s)) {
 		s = scan_word(s, PL_tokenbuf, sizeof PL_tokenbuf, TRUE, &len);
 		PL_in_my_stash = gv_stashpv(PL_tokenbuf, FALSE);
 		if (!PL_in_my_stash) {
@@ -3712,9 +3778,9 @@ yylex(void)
 
 	case KEY_open:
 	    s = skipspace(s);
-	    if (isIDFIRST(*s)) {
+	    if (isIDFIRST_lazy(s)) {
 		char *t;
-		for (d = s; isALNUM(*d); d++) ;
+		for (d = s; isALNUM_lazy(d); d++) ;
 		t = skipspace(d);
 		if (strchr("|&*+-=!?:.", *t))
 		    warn("Precedence problem: open %.*s should be open(%.*s)",
@@ -3779,36 +3845,46 @@ yylex(void)
 	    s = scan_str(s);
 	    if (!s)
 		missingterm((char*)0);
-	    if (ckWARN(WARN_SYNTAX) && SvLEN(PL_lex_stuff)) {
+	    force_next(')');
+	    if (SvCUR(PL_lex_stuff)) {
+		OP *words = Nullop;
+		int warned = 0;
 		d = SvPV_force(PL_lex_stuff, len);
-		for (; len; --len, ++d) {
-		    if (*d == ',') {
-			warner(WARN_SYNTAX,
-			    "Possible attempt to separate words with commas");
-			break;
-		    }
-		    if (*d == '#') {
-			warner(WARN_SYNTAX,
-			    "Possible attempt to put comments in qw() list");
-			break;
+		while (len) {
+		    for (; isSPACE(*d) && len; --len, ++d) ;
+		    if (len) {
+			char *b = d;
+			if (!warned && ckWARN(WARN_SYNTAX)) {
+			    for (; !isSPACE(*d) && len; --len, ++d) {
+				if (*d == ',') {
+				    warner(WARN_SYNTAX,
+					"Possible attempt to separate words with commas");
+				    ++warned;
+				}
+				else if (*d == '#') {
+				    warner(WARN_SYNTAX,
+					"Possible attempt to put comments in qw() list");
+				    ++warned;
+				}
+			    }
+			}
+			else {
+			    for (; !isSPACE(*d) && len; --len, ++d) ;
+			}
+			words = append_elem(OP_LIST, words,
+					    newSVOP(OP_CONST, 0, newSVpvn(b, d-b)));
 		    }
 		}
+		if (words) {
+		    PL_nextval[PL_nexttoke].opval = words;
+		    force_next(THING);
+		}
 	    }
-	    force_next(')');
-	    PL_nextval[PL_nexttoke].opval = (OP*)newSVOP(OP_CONST, 0, tokeq(PL_lex_stuff));
+	    if (PL_lex_stuff)
+		SvREFCNT_dec(PL_lex_stuff);
 	    PL_lex_stuff = Nullsv;
-	    force_next(THING);
-	    force_next(',');
-	    PL_nextval[PL_nexttoke].opval = (OP*)newSVOP(OP_CONST, 0, newSVpv(" ",1));
-	    force_next(THING);
-	    force_next('(');
-	    yylval.ival = OP_SPLIT;
-	    CLINE;
 	    PL_expect = XTERM;
-	    PL_bufptr = s;
-	    PL_last_lop = PL_oldbufptr;
-	    PL_last_lop_op = OP_SPLIT;
-	    return FUNC;
+	    TOKEN('(');
 
 	case KEY_qq:
 	    s = scan_str(s);
@@ -3837,7 +3913,7 @@ yylex(void)
 	case KEY_require:
 	    *PL_tokenbuf = '\0';
 	    s = force_word(s,WORD,TRUE,TRUE,FALSE);
-	    if (isIDFIRST(*PL_tokenbuf))
+	    if (isIDFIRST_lazy(PL_tokenbuf))
 		gv_stashpvn(PL_tokenbuf, strlen(PL_tokenbuf), TRUE);
 	    else if (*s == '<')
 		yyerror("<> should be quotes");
@@ -4021,7 +4097,7 @@ yylex(void)
 	  really_sub:
 	    s = skipspace(s);
 
-	    if (isIDFIRST(*s) || *s == '\'' || *s == ':') {
+	    if (isIDFIRST_lazy(s) || *s == '\'' || *s == ':') {
 		char tmpbuf[sizeof PL_tokenbuf];
 		PL_expect = XBLOCK;
 		d = scan_word(s, tmpbuf, sizeof tmpbuf, TRUE, &len);
@@ -4081,7 +4157,7 @@ yylex(void)
 		PL_lex_stuff = Nullsv;
 	    }
 
-	    if (*SvPV(PL_subname,PL_na) == '?') {
+	    if (*SvPV(PL_subname,n_a) == '?') {
 		sv_setpv(PL_subname,"__ANON__");
 		TOKEN(ANONSUB);
 	    }
@@ -4893,9 +4969,9 @@ checkcomma(register char *s, char *name, char *what)
 	s++;
     while (s < PL_bufend && isSPACE(*s))
 	s++;
-    if (isIDFIRST(*s)) {
+    if (isIDFIRST_lazy(s)) {
 	w = s++;
-	while (isALNUM(*s))
+	while (isALNUM_lazy(s))
 	    s++;
 	while (s < PL_bufend && isSPACE(*s))
 	    s++;
@@ -4921,7 +4997,6 @@ new_constant(char *s, STRLEN len, char *key, SV *sv, SV *pv, char *type)
     bool oldcatch = CATCH_GET;
     SV **cvp;
     SV *cv, *typesv;
-    char buf[128];
 	    
     if (!table) {
 	yyerror("%^H is not defined");
@@ -4929,6 +5004,7 @@ new_constant(char *s, STRLEN len, char *key, SV *sv, SV *pv, char *type)
     }
     cvp = hv_fetch(table, key, strlen(key), FALSE);
     if (!cvp || !SvOK(*cvp)) {
+	char buf[128];
 	sprintf(buf,"$^H{%s} is not defined", key);
 	yyerror(buf);
 	return sv;
@@ -4936,7 +5012,7 @@ new_constant(char *s, STRLEN len, char *key, SV *sv, SV *pv, char *type)
     sv_2mortal(sv);			/* Parent created it permanently */
     cv = *cvp;
     if (!pv)
-	pv = sv_2mortal(newSVpv(s, len));
+	pv = sv_2mortal(newSVpvn(s, len));
     if (type)
 	typesv = sv_2mortal(newSVpv(type, 0));
     else
@@ -4974,6 +5050,7 @@ new_constant(char *s, STRLEN len, char *key, SV *sv, SV *pv, char *type)
     POPSTACK;
 
     if (!SvOK(res)) {
+	char buf[128];
 	sprintf(buf,"Call to &{$^H{%s}} did not return a defined value", key);
 	yyerror(buf);
     }
@@ -4988,9 +5065,9 @@ scan_word(register char *s, char *dest, STRLEN destlen, int allow_package, STRLE
     for (;;) {
 	if (d >= e)
 	    croak(ident_too_long);
-	if (isALNUM(*s))
+	if (isALNUM(*s))	/* UTF handled below */
 	    *d++ = *s++;
-	else if (*s == '\'' && allow_package && isIDFIRST(s[1])) {
+	else if (*s == '\'' && allow_package && isIDFIRST_lazy(s+1)) {
 	    *d++ = ':';
 	    *d++ = ':';
 	    s++;
@@ -4999,7 +5076,7 @@ scan_word(register char *s, char *dest, STRLEN destlen, int allow_package, STRLE
 	    *d++ = *s++;
 	    *d++ = *s++;
 	}
-	else if (UTF && (*s & 0xc0) == 0x80 && isALNUM_utf8((U8*)s)) {
+	else if (UTF && *(U8*)s >= 0xc0 && isALNUM_utf8((U8*)s)) {
 	    char *t = s + UTF8SKIP(s);
 	    while (*t & 0x80 && is_utf8_mark((U8*)t))
 		t += UTF8SKIP(t);
@@ -5042,9 +5119,9 @@ scan_ident(register char *s, register char *send, char *dest, STRLEN destlen, I3
 	for (;;) {
 	    if (d >= e)
 		croak(ident_too_long);
-	    if (isALNUM(*s))
+	    if (isALNUM(*s))	/* UTF handled below */
 		*d++ = *s++;
-	    else if (*s == '\'' && isIDFIRST(s[1])) {
+	    else if (*s == '\'' && isIDFIRST_lazy(s+1)) {
 		*d++ = ':';
 		*d++ = ':';
 		s++;
@@ -5053,7 +5130,7 @@ scan_ident(register char *s, register char *send, char *dest, STRLEN destlen, I3
 		*d++ = *s++;
 		*d++ = *s++;
 	    }
-	    else if (UTF && (*s & 0xc0) == 0x80 && isALNUM_utf8((U8*)s)) {
+	    else if (UTF && *(U8*)s >= 0xc0 && isALNUM_utf8((U8*)s)) {
 		char *t = s + UTF8SKIP(s);
 		while (*t & 0x80 && is_utf8_mark((U8*)t))
 		    t += UTF8SKIP(t);
@@ -5075,7 +5152,7 @@ scan_ident(register char *s, register char *send, char *dest, STRLEN destlen, I3
 	return s;
     }
     if (*s == '$' && s[1] &&
-	(isALNUM(s[1]) || strchr("${", s[1]) || strnEQ(s+1,"::",2)) )
+	(isALNUM_lazy(s+1) || strchr("${", s[1]) || strnEQ(s+1,"::",2)) )
     {
 	return s;
     }
@@ -5088,7 +5165,7 @@ scan_ident(register char *s, register char *send, char *dest, STRLEN destlen, I3
     if (s < send)
 	*d = *s++;
     d[1] = '\0';
-    if (*d == '^' && *s && (isUPPER(*s) || strchr("[\\]^_?", *s))) {
+    if (*d == '^' && *s && isCONTROLVAR(*s)) {
 	*d = toCTRL(*s);
 	s++;
     }
@@ -5102,11 +5179,11 @@ scan_ident(register char *s, register char *send, char *dest, STRLEN destlen, I3
 		}
 	    }
 	}
-	if (isIDFIRST(*d) || (UTF && (*d & 0xc0) == 0x80 && isIDFIRST_utf8((U8*)d))) {
+	if (isIDFIRST_lazy(d)) {
 	    d++;
 	    if (UTF) {
 		e = s;
-		while (e < send && (isALNUM(*e) || ((*e & 0xc0) == 0x80 && isALNUM_utf8((U8*)e)) || *e == ':')) {
+		while (e < send && isALNUM_lazy(e) || *e == ':') {
 		    e += UTF8SKIP(e);
 		    while (e < send && *e & 0x80 && is_utf8_mark((U8*)e))
 			e += UTF8SKIP(e);
@@ -5116,8 +5193,10 @@ scan_ident(register char *s, register char *send, char *dest, STRLEN destlen, I3
 		s = e;
 	    }
 	    else {
-		while (isALNUM(*s) || *s == ':')
+		while ((isALNUM(*s) || *s == ':') && d < e)
 		    *d++ = *s++;
+		if (d >= e)
+		    croak(ident_too_long);
 	    }
 	    *d = '\0';
 	    while (s < send && (*s == ' ' || *s == '\t')) s++;
@@ -5134,6 +5213,19 @@ scan_ident(register char *s, register char *send, char *dest, STRLEN destlen, I3
 		PL_lex_brackstack[PL_lex_brackets++] = XOPERATOR;
 		return s;
 	    }
+	} 
+	/* Handle extended ${^Foo} variables 
+	 * 1999-02-27 mjd-perl-patch@plover.com */
+	else if (!isALNUM(*d) && !isPRINT(*d) /* isCTRL(d) */
+		 && isALNUM(*s))
+	{
+	    d++;
+	    while (isALNUM(*s) && d < e) {
+		*d++ = *s++;
+	    }
+	    if (d >= e)
+		croak(ident_too_long);
+	    *d = '\0';
 	}
 	if (*s == '}') {
 	    s++;
@@ -5261,8 +5353,11 @@ scan_subst(char *start)
 
     if (es) {
 	SV *repl;
+	PL_sublex_info.super_bufptr = s;
+	PL_sublex_info.super_bufend = PL_bufend;
+	PL_multi_end = 0;
 	pm->op_pmflags |= PMf_EVAL;
-	repl = newSVpv("",0);
+	repl = newSVpvn("",0);
 	while (es-- > 0)
 	    sv_catpv(repl, es ? "eval " : "do ");
 	sv_catpvn(repl, "{ ", 2);
@@ -5392,9 +5487,9 @@ scan_heredoc(register char *s)
 	    s++, term = '\'';
 	else
 	    term = '"';
-	if (!isALNUM(*s))
+	if (!isALNUM_lazy(s))
 	    deprecate("bare << to mean <<\"\"");
-	for (; isALNUM(*s); s++) {
+	for (; isALNUM_lazy(s); s++) {
 	    if (d < e)
 		*d++ = *s;
 	}
@@ -5430,9 +5525,9 @@ scan_heredoc(register char *s)
 #endif
     d = "\n";
     if (outer || !(d=ninstr(s,PL_bufend,d,d+1)))
-	herewas = newSVpv(s,PL_bufend-s);
+	herewas = newSVpvn(s,PL_bufend-s);
     else
-	s--, herewas = newSVpv(s,d-s);
+	s--, herewas = newSVpvn(s,d-s);
     s += SvCUR(herewas);
 
     tmpstr = NEWSV(87,79);
@@ -5450,7 +5545,33 @@ scan_heredoc(register char *s)
     PL_multi_start = PL_curcop->cop_line;
     PL_multi_open = PL_multi_close = '<';
     term = *PL_tokenbuf;
-    if (!outer) {
+    if (PL_lex_inwhat == OP_SUBST && PL_in_eval && !PL_rsfp) {
+	char *bufptr = PL_sublex_info.super_bufptr;
+	char *bufend = PL_sublex_info.super_bufend;
+	char *olds = s - SvCUR(herewas);
+	s = strchr(bufptr, '\n');
+	if (!s)
+	    s = bufend;
+	d = s;
+	while (s < bufend &&
+	  (*s != term || memNE(s,PL_tokenbuf,len)) ) {
+	    if (*s++ == '\n')
+		PL_curcop->cop_line++;
+	}
+	if (s >= bufend) {
+	    PL_curcop->cop_line = PL_multi_start;
+	    missingterm(PL_tokenbuf);
+	}
+	sv_setpvn(herewas,bufptr,d-bufptr+1);
+	sv_setpvn(tmpstr,d+1,s-d);
+	s += len - 1;
+	sv_catpvn(herewas,s,bufend-s);
+	(void)strcpy(bufptr,SvPVX(herewas));
+
+	s = olds;
+	goto retval;
+    }
+    else if (!outer) {
 	d = s;
 	while (s < PL_bufend &&
 	  (*s != term || memNE(s,PL_tokenbuf,len)) ) {
@@ -5514,8 +5635,9 @@ scan_heredoc(register char *s)
 	    sv_catsv(tmpstr,PL_linestr);
 	}
     }
-    PL_multi_end = PL_curcop->cop_line;
     s++;
+retval:
+    PL_multi_end = PL_curcop->cop_line;
     if (SvCUR(tmpstr) + 5 < SvLEN(tmpstr)) {
 	SvLEN_set(tmpstr, SvCUR(tmpstr) + 1);
 	Renew(SvPVX(tmpstr), SvLEN(tmpstr), char);
@@ -5548,19 +5670,23 @@ scan_inputsymbol(char *start)
     register char *s = start;		/* current position in buffer */
     register char *d;
     register char *e;
+    char *end;
     I32 len;
 
     d = PL_tokenbuf;			/* start of temp holding space */
     e = PL_tokenbuf + sizeof PL_tokenbuf;	/* end of temp holding space */
-    s = delimcpy(d, e, s + 1, PL_bufend, '>', &len);	/* extract until > */
+    end = strchr(s, '\n');
+    if (!end)
+	end = PL_bufend;
+    s = delimcpy(d, e, s + 1, end, '>', &len);	/* extract until > */
 
     /* die if we didn't have space for the contents of the <>,
-       or if it didn't end
+       or if it didn't end, or if we see a newline
     */
 
     if (len >= sizeof PL_tokenbuf)
 	croak("Excessively long <> operator");
-    if (s >= PL_bufend)
+    if (s >= end)
 	croak("Unterminated <> operator");
 
     s++;
@@ -5575,7 +5701,7 @@ scan_inputsymbol(char *start)
     if (*d == '$' && d[1]) d++;
 
     /* allow <Pkg'VALUE> or <Pkg::VALUE> */
-    while (*d && (isALNUM(*d) || *d == '\'' || *d == ':'))
+    while (*d && (isALNUM_lazy(d) || *d == '\'' || *d == ':'))
 	d++;
 
     /* If we've tried to read what we allow filehandles to look like, and
@@ -5612,16 +5738,16 @@ scan_inputsymbol(char *start)
 	    if ((tmp = pad_findmy(d)) != NOT_IN_PAD) {
 		OP *o = newOP(OP_PADSV, 0);
 		o->op_targ = tmp;
-		PL_lex_op = (OP*)newUNOP(OP_READLINE, 0, newUNOP(OP_RV2GV, 0, o));
+		PL_lex_op = (OP*)newUNOP(OP_READLINE, 0, o);
 	    }
 	    else {
 		GV *gv = gv_fetchpv(d+1,TRUE, SVt_PV);
 		PL_lex_op = (OP*)newUNOP(OP_READLINE, 0,
-					newUNOP(OP_RV2GV, 0,
 					    newUNOP(OP_RV2SV, 0,
-						newGVOP(OP_GV, 0, gv))));
+						newGVOP(OP_GV, 0, gv)));
 	    }
-	    /* we created the ops in lex_op, so make yylval.ival a null op */
+	    PL_lex_op->op_flags |= OPf_SPECIAL;
+	    /* we created the ops in PL_lex_op, so make yylval.ival a null op */
 	    yylval.ival = OP_NULL;
 	}
 
@@ -5851,7 +5977,7 @@ scan_str(char *start)
 
   Read a number in any of the formats that Perl accepts:
 
-  0(x[0-7A-F]+)|([0-7]+)
+  0(x[0-7A-F]+)|([0-7]+)|(b[01])
   [\d_]+(\.[\d_]*)?[Ee](\d+)
 
   Underbars (_) are allowed in decimal numbers.  If -w is on,
@@ -5885,18 +6011,19 @@ scan_num(char *start)
       croak("panic: scan_num");
       
     /* if it starts with a 0, it could be an octal number, a decimal in
-       0.13 disguise, or a hexadecimal number.
+       0.13 disguise, or a hexadecimal number, or a binary number.
     */
     case '0':
 	{
 	  /* variables:
 	     u		holds the "number so far"
-	     shift	the power of 2 of the base (hex == 4, octal == 3)
+	     shift	the power of 2 of the base
+			(hex == 4, octal == 3, binary == 1)
 	     overflowed	was the number more than we can hold?
 
 	     Shift is used when we add a digit.  It also serves as an "are
-	     we in octal or hex?" indicator to disallow hex characters when
-	     in octal mode.
+	     we in octal/hex/binary?" indicator to disallow hex characters
+	     when in octal mode.
 	   */
 	    UV u;
 	    I32 shift;
@@ -5906,6 +6033,9 @@ scan_num(char *start)
 	    if (s[1] == 'x') {
 		shift = 4;
 		s += 2;
+	    } else if (s[1] == 'b') {
+		shift = 1;
+		s += 2;
 	    }
 	    /* check for a decimal in disguise */
 	    else if (s[1] == '.')
@@ -5915,7 +6045,7 @@ scan_num(char *start)
 		shift = 3;
 	    u = 0;
 
-	    /* read the rest of the octal number */
+	    /* read the rest of the number */
 	    for (;;) {
 		UV n, b;	/* n is used in the overflow test, b is the digit we're adding on */
 
@@ -5932,13 +6062,21 @@ scan_num(char *start)
 
 		/* 8 and 9 are not octal */
 		case '8': case '9':
-		    if (shift != 4)
-			yyerror("Illegal octal digit");
+		    if (shift == 3)
+			yyerror(form("Illegal octal digit '%c'", *s));
+		    else
+			if (shift == 1)
+			    yyerror(form("Illegal binary digit '%c'", *s));
 		    /* FALL THROUGH */
 
 	        /* octal digits */
-		case '0': case '1': case '2': case '3': case '4':
+		case '2': case '3': case '4':
 		case '5': case '6': case '7':
+		    if (shift == 1)
+			yyerror(form("Illegal binary digit '%c'", *s));
+		    /* FALL THROUGH */
+
+		case '0': case '1':
 		    b = *s++ & 15;		/* ASCII digit -> value of digit */
 		    goto digit;
 
@@ -5959,7 +6097,8 @@ scan_num(char *start)
 		    if (!overflowed && (n >> shift) != u
 			&& !(PL_hints & HINT_NEW_BINARY)) {
 			warn("Integer overflow in %s number",
-			     (shift == 4) ? "hex" : "octal");
+			     (shift == 4) ? "hex"
+			     : ((shift == 3) ? "octal" : "binary"));
 			overflowed = TRUE;
 		    }
 		    u = n | b;		/* add the digit to the end */
@@ -6099,7 +6238,7 @@ scan_formline(register char *s)
     dTHR;
     register char *eol;
     register char *t;
-    SV *stuff = newSVpv("",0);
+    SV *stuff = newSVpvn("",0);
     bool needargs = FALSE;
 
     while (!needargs) {
@@ -6110,7 +6249,7 @@ scan_formline(register char *s)
 #else
 	    for (t = s+1;*t == ' ' || *t == '\t' || *t == '\r'; t++) ;
 #endif
-	    if (*t == '\n')
+	    if (*t == '\n' || t == PL_bufend)
 		break;
 	}
 	if (PL_in_eval && !PL_rsfp) {
@@ -6212,7 +6351,7 @@ start_subparse(I32 is_format, U32 flags)
     PL_padix = 0;
     PL_subline = PL_curcop->cop_line;
 #ifdef USE_THREADS
-    av_store(PL_comppad_name, 0, newSVpv("@_", 2));
+    av_store(PL_comppad_name, 0, newSVpvn("@_", 2));
     PL_curpad[0] = (SV*)newAV();
     SvPADMY_on(PL_curpad[0]);	/* XXX Needed? */
 #endif /* USE_THREADS */
@@ -6281,7 +6420,7 @@ yyerror(char *s)
 	    where = "within string";
     }
     else {
-	SV *where_sv = sv_2mortal(newSVpv("next char ", 0));
+	SV *where_sv = sv_2mortal(newSVpvn("next char ", 10));
 	if (yychar < 32)
 	    sv_catpvf(where_sv, "^%c", toCTRL(yychar));
 	else if (isPRINT_LC(yychar))