This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
https://perl5.git.perl.org / perl5.git / blobdiff
? search:
summary | shortlog | log | commit | commitdiff | tree
raw | inline | side by side
Add rt69056.t to MANIFEST
[perl5.git] / toke.c
diff --git a/toke.c b/toke.c
index ead6806..de163fb 100644 (file)
--- a/toke.c
+++ b/toke.c
@@ -1,7 +1,7 @@
 /*    toke.c
  *
 /*    toke.c
  *
- *    Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999,
- *    2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, by Larry Wall and others
+ *    Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000,
+ *    2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008 by Larry Wall and others
  *
  *    You may distribute under the terms of either the GNU General Public
  *    License or the Artistic License, as specified in the README file.
  *
  *    You may distribute under the terms of either the GNU General Public
  *    License or the Artistic License, as specified in the README file.
@@ -9,7 +9,9 @@
  */
 
 /*
  */
 
 /*
- *   "It all comes from here, the stench and the peril."  --Frodo
+ *  'It all comes from here, the stench and the peril.'    --Frodo
+ *
+ *     [p.719 of _The Lord of the Rings_, IV/ix: "Shelob's Lair"]
  */
 
 /*
  */
 
 /*
@@ -23,7 +25,10 @@
 #define PERL_IN_TOKE_C
 #include "perl.h"
 
 #define PERL_IN_TOKE_C
 #include "perl.h"
 
-#define yylval (PL_parser->yylval)
+#define new_constant(a,b,c,d,e,f,g)    \
+       S_new_constant(aTHX_ a,b,STR_WITH_LEN(c),d,e,f, g)
+
+#define pl_yylval      (PL_parser->yylval)
 
 /* YYINITDEPTH -- initial size of the parser's stacks.  */
 #define YYINITDEPTH 200
 
 /* YYINITDEPTH -- initial size of the parser's stacks.  */
 #define YYINITDEPTH 200
@@ -119,16 +124,14 @@ static I32 utf16rev_textfilter(pTHX_ int idx, SV *sv, int maxlen);
 #   define UTF ((PL_linestr && DO_UTF8(PL_linestr)) || (PL_hints & HINT_UTF8))
 #endif
 
 #   define UTF ((PL_linestr && DO_UTF8(PL_linestr)) || (PL_hints & HINT_UTF8))
 #endif
 
+/* The maximum number of characters preceding the unrecognized one to display */
+#define UNRECOGNIZED_PRECEDE_COUNT 10
+
 /* In variables named $^X, these are the legal values for X.
  * 1999-02-27 mjd-perl-patch@plover.com */
 #define isCONTROLVAR(x) (isUPPER(x) || strchr("[\\]^_?", (x)))
 
 /* In variables named $^X, these are the legal values for X.
  * 1999-02-27 mjd-perl-patch@plover.com */
 #define isCONTROLVAR(x) (isUPPER(x) || strchr("[\\]^_?", (x)))
 
-/* On MacOS, respect nonbreaking spaces */
-#ifdef MACOS_TRADITIONAL
-#define SPACE_OR_TAB(c) ((c)==' '||(c)=='\312'||(c)=='\t')
-#else
 #define SPACE_OR_TAB(c) ((c)==' '||(c)=='\t')
 #define SPACE_OR_TAB(c) ((c)==' '||(c)=='\t')
-#endif
 
 /* LEX_* are values for PL_lex_state, the state of the lexer.
  * They are arranged oddly so that the guard on the switch statement
 
 /* LEX_* are values for PL_lex_state, the state of the lexer.
  * They are arranged oddly so that the guard on the switch statement
@@ -224,7 +227,7 @@ static const char* const lex_state_names[] = {
  */
 
 #ifdef DEBUGGING /* Serve -DT. */
  */
 
 #ifdef DEBUGGING /* Serve -DT. */
-#   define REPORT(retval) tokereport((I32)retval)
+#   define REPORT(retval) tokereport((I32)retval, &pl_yylval)
 #else
 #   define REPORT(retval) (retval)
 #endif
 #else
 #   define REPORT(retval) (retval)
 #endif
@@ -236,19 +239,19 @@ static const char* const lex_state_names[] = {
 #define PRETERMBLOCK(retval) return (PL_expect = XTERMBLOCK,PL_bufptr = s, REPORT(retval))
 #define PREREF(retval) return (PL_expect = XREF,PL_bufptr = s, REPORT(retval))
 #define TERM(retval) return (CLINE, PL_expect = XOPERATOR, PL_bufptr = s, REPORT(retval))
 #define PRETERMBLOCK(retval) return (PL_expect = XTERMBLOCK,PL_bufptr = s, REPORT(retval))
 #define PREREF(retval) return (PL_expect = XREF,PL_bufptr = s, REPORT(retval))
 #define TERM(retval) return (CLINE, PL_expect = XOPERATOR, PL_bufptr = s, REPORT(retval))
-#define LOOPX(f) return (yylval.ival=f, PL_expect=XTERM, PL_bufptr=s, REPORT((int)LOOPEX))
-#define FTST(f)  return (yylval.ival=f, PL_expect=XTERMORDORDOR, PL_bufptr=s, REPORT((int)UNIOP))
-#define FUN0(f)  return (yylval.ival=f, PL_expect=XOPERATOR, PL_bufptr=s, REPORT((int)FUNC0))
-#define FUN1(f)  return (yylval.ival=f, PL_expect=XOPERATOR, PL_bufptr=s, REPORT((int)FUNC1))
-#define BOop(f)  return ao((yylval.ival=f, PL_expect=XTERM, PL_bufptr=s, REPORT((int)BITOROP)))
-#define BAop(f)  return ao((yylval.ival=f, PL_expect=XTERM, PL_bufptr=s, REPORT((int)BITANDOP)))
-#define SHop(f)  return ao((yylval.ival=f, PL_expect=XTERM, PL_bufptr=s, REPORT((int)SHIFTOP)))
-#define PWop(f)  return ao((yylval.ival=f, PL_expect=XTERM, PL_bufptr=s, REPORT((int)POWOP)))
-#define PMop(f)  return(yylval.ival=f, PL_expect=XTERM, PL_bufptr=s, REPORT((int)MATCHOP))
-#define Aop(f)   return ao((yylval.ival=f, PL_expect=XTERM, PL_bufptr=s, REPORT((int)ADDOP)))
-#define Mop(f)   return ao((yylval.ival=f, PL_expect=XTERM, PL_bufptr=s, REPORT((int)MULOP)))
-#define Eop(f)   return (yylval.ival=f, PL_expect=XTERM, PL_bufptr=s, REPORT((int)EQOP))
-#define Rop(f)   return (yylval.ival=f, PL_expect=XTERM, PL_bufptr=s, REPORT((int)RELOP))
+#define LOOPX(f) return (pl_yylval.ival=f, PL_expect=XTERM, PL_bufptr=s, REPORT((int)LOOPEX))
+#define FTST(f)  return (pl_yylval.ival=f, PL_expect=XTERMORDORDOR, PL_bufptr=s, REPORT((int)UNIOP))
+#define FUN0(f)  return (pl_yylval.ival=f, PL_expect=XOPERATOR, PL_bufptr=s, REPORT((int)FUNC0))
+#define FUN1(f)  return (pl_yylval.ival=f, PL_expect=XOPERATOR, PL_bufptr=s, REPORT((int)FUNC1))
+#define BOop(f)  return ao((pl_yylval.ival=f, PL_expect=XTERM, PL_bufptr=s, REPORT((int)BITOROP)))
+#define BAop(f)  return ao((pl_yylval.ival=f, PL_expect=XTERM, PL_bufptr=s, REPORT((int)BITANDOP)))
+#define SHop(f)  return ao((pl_yylval.ival=f, PL_expect=XTERM, PL_bufptr=s, REPORT((int)SHIFTOP)))
+#define PWop(f)  return ao((pl_yylval.ival=f, PL_expect=XTERM, PL_bufptr=s, REPORT((int)POWOP)))
+#define PMop(f)  return(pl_yylval.ival=f, PL_expect=XTERM, PL_bufptr=s, REPORT((int)MATCHOP))
+#define Aop(f)   return ao((pl_yylval.ival=f, PL_expect=XTERM, PL_bufptr=s, REPORT((int)ADDOP)))
+#define Mop(f)   return ao((pl_yylval.ival=f, PL_expect=XTERM, PL_bufptr=s, REPORT((int)MULOP)))
+#define Eop(f)   return (pl_yylval.ival=f, PL_expect=XTERM, PL_bufptr=s, REPORT((int)EQOP))
+#define Rop(f)   return (pl_yylval.ival=f, PL_expect=XTERM, PL_bufptr=s, REPORT((int)RELOP))
 
 /* This bit of chicanery makes a unary function followed by
  * a parenthesis into a function with one argument, highest precedence.
 
 /* This bit of chicanery makes a unary function followed by
  * a parenthesis into a function with one argument, highest precedence.
@@ -256,7 +259,7 @@ static const char* const lex_state_names[] = {
  * operator (such as C<shift // 0>).
  */
 #define UNI2(f,x) { \
  * operator (such as C<shift // 0>).
  */
 #define UNI2(f,x) { \
-       yylval.ival = f; \
+       pl_yylval.ival = f; \
        PL_expect = x; \
        PL_bufptr = s; \
        PL_last_uni = PL_oldbufptr; \
        PL_expect = x; \
        PL_bufptr = s; \
        PL_last_uni = PL_oldbufptr; \
@@ -270,7 +273,7 @@ static const char* const lex_state_names[] = {
 #define UNIDOR(f) UNI2(f,XTERMORDORDOR)
 
 #define UNIBRACK(f) { \
 #define UNIDOR(f) UNI2(f,XTERMORDORDOR)
 
 #define UNIBRACK(f) { \
-       yylval.ival = f; \
+       pl_yylval.ival = f; \
        PL_bufptr = s; \
        PL_last_uni = PL_oldbufptr; \
        if (*s == '(') \
        PL_bufptr = s; \
        PL_last_uni = PL_oldbufptr; \
        if (*s == '(') \
@@ -280,15 +283,15 @@ static const char* const lex_state_names[] = {
        }
 
 /* grandfather return to old style */
        }
 
 /* grandfather return to old style */
-#define OLDLOP(f) return(yylval.ival=f,PL_expect = XTERM,PL_bufptr = s,(int)LSTOP)
+#define OLDLOP(f) return(pl_yylval.ival=f,PL_expect = XTERM,PL_bufptr = s,(int)LSTOP)
 
 #ifdef DEBUGGING
 
 
 #ifdef DEBUGGING
 
-/* how to interpret the yylval associated with the token */
+/* how to interpret the pl_yylval associated with the token */
 enum token_type {
     TOKENTYPE_NONE,
     TOKENTYPE_IVAL,
 enum token_type {
     TOKENTYPE_NONE,
     TOKENTYPE_IVAL,
-    TOKENTYPE_OPNUM, /* yylval.ival contains an opcode number */
+    TOKENTYPE_OPNUM, /* pl_yylval.ival contains an opcode number */
     TOKENTYPE_PVAL,
     TOKENTYPE_OPVAL,
     TOKENTYPE_GVVAL
     TOKENTYPE_PVAL,
     TOKENTYPE_OPVAL,
     TOKENTYPE_GVVAL
@@ -365,15 +368,19 @@ static struct debug_tokens {
     { WHEN,            TOKENTYPE_IVAL,         "WHEN" },
     { WHILE,           TOKENTYPE_IVAL,         "WHILE" },
     { WORD,            TOKENTYPE_OPVAL,        "WORD" },
     { WHEN,            TOKENTYPE_IVAL,         "WHEN" },
     { WHILE,           TOKENTYPE_IVAL,         "WHILE" },
     { WORD,            TOKENTYPE_OPVAL,        "WORD" },
+    { YADAYADA,                TOKENTYPE_IVAL,         "YADAYADA" },
     { 0,               TOKENTYPE_NONE,         NULL }
 };
 
     { 0,               TOKENTYPE_NONE,         NULL }
 };
 
-/* dump the returned token in rv, plus any optional arg in yylval */
+/* dump the returned token in rv, plus any optional arg in pl_yylval */
 
 STATIC int
 
 STATIC int
-S_tokereport(pTHX_ I32 rv)
+S_tokereport(pTHX_ I32 rv, const YYSTYPE* lvalp)
 {
     dVAR;
 {
     dVAR;
+
+    PERL_ARGS_ASSERT_TOKEREPORT;
+
     if (DEBUG_T_TEST) {
        const char *name = NULL;
        enum token_type type = TOKENTYPE_NONE;
     if (DEBUG_T_TEST) {
        const char *name = NULL;
        enum token_type type = TOKENTYPE_NONE;
@@ -400,22 +407,22 @@ S_tokereport(pTHX_ I32 rv)
        case TOKENTYPE_GVVAL: /* doesn't appear to be used */
            break;
        case TOKENTYPE_IVAL:
        case TOKENTYPE_GVVAL: /* doesn't appear to be used */
            break;
        case TOKENTYPE_IVAL:
-           Perl_sv_catpvf(aTHX_ report, "(ival=%"IVdf")", (IV)yylval.ival);
+           Perl_sv_catpvf(aTHX_ report, "(ival=%"IVdf")", (IV)lvalp->ival);
            break;
        case TOKENTYPE_OPNUM:
            Perl_sv_catpvf(aTHX_ report, "(ival=op_%s)",
            break;
        case TOKENTYPE_OPNUM:
            Perl_sv_catpvf(aTHX_ report, "(ival=op_%s)",
-                                   PL_op_name[yylval.ival]);
+                                   PL_op_name[lvalp->ival]);
            break;
        case TOKENTYPE_PVAL:
            break;
        case TOKENTYPE_PVAL:
-           Perl_sv_catpvf(aTHX_ report, "(pval=\"%s\")", yylval.pval);
+           Perl_sv_catpvf(aTHX_ report, "(pval=\"%s\")", lvalp->pval);
            break;
        case TOKENTYPE_OPVAL:
            break;
        case TOKENTYPE_OPVAL:
-           if (yylval.opval) {
+           if (lvalp->opval) {
                Perl_sv_catpvf(aTHX_ report, "(opval=op_%s)",
                Perl_sv_catpvf(aTHX_ report, "(opval=op_%s)",
-                                   PL_op_name[yylval.opval->op_type]);
-               if (yylval.opval->op_type == OP_CONST) {
+                                   PL_op_name[lvalp->opval->op_type]);
+               if (lvalp->opval->op_type == OP_CONST) {
                    Perl_sv_catpvf(aTHX_ report, " %s",
                    Perl_sv_catpvf(aTHX_ report, " %s",
-                       SvPEEK(cSVOPx_sv(yylval.opval)));
+                       SvPEEK(cSVOPx_sv(lvalp->opval)));
                }
 
            }
                }
 
            }
@@ -432,9 +439,12 @@ S_tokereport(pTHX_ I32 rv)
 /* print the buffer with suitable escapes */
 
 STATIC void
 /* print the buffer with suitable escapes */
 
 STATIC void
-S_printbuf(pTHX_ const char* fmt, const char* s)
+S_printbuf(pTHX_ const char *const fmt, const char *const s)
 {
     SV* const tmp = newSVpvs("");
 {
     SV* const tmp = newSVpvs("");
+
+    PERL_ARGS_ASSERT_PRINTBUF;
+
     PerlIO_printf(Perl_debug_log, fmt, pv_display(tmp, s, strlen(s), 0, 60));
     SvREFCNT_dec(tmp);
 }
     PerlIO_printf(Perl_debug_log, fmt, pv_display(tmp, s, strlen(s), 0, 60));
     SvREFCNT_dec(tmp);
 }
@@ -455,11 +465,11 @@ S_ao(pTHX_ int toketype)
     if (*PL_bufptr == '=') {
        PL_bufptr++;
        if (toketype == ANDAND)
     if (*PL_bufptr == '=') {
        PL_bufptr++;
        if (toketype == ANDAND)
-           yylval.ival = OP_ANDASSIGN;
+           pl_yylval.ival = OP_ANDASSIGN;
        else if (toketype == OROR)
        else if (toketype == OROR)
-           yylval.ival = OP_ORASSIGN;
+           pl_yylval.ival = OP_ORASSIGN;
        else if (toketype == DORDOR)
        else if (toketype == DORDOR)
-           yylval.ival = OP_DORASSIGN;
+           pl_yylval.ival = OP_DORASSIGN;
        toketype = ASSIGNOP;
     }
     return toketype;
        toketype = ASSIGNOP;
     }
     return toketype;
@@ -479,12 +489,14 @@ S_ao(pTHX_ int toketype)
  */
 
 STATIC void
  */
 
 STATIC void
-S_no_op(pTHX_ const char *what, char *s)
+S_no_op(pTHX_ const char *const what, char *s)
 {
     dVAR;
     char * const oldbp = PL_bufptr;
     const bool is_first = (PL_oldbufptr == PL_linestart);
 
 {
     dVAR;
     char * const oldbp = PL_bufptr;
     const bool is_first = (PL_oldbufptr == PL_linestart);
 
+    PERL_ARGS_ASSERT_NO_OP;
+
     if (!s)
        s = oldbp;
     else
     if (!s)
        s = oldbp;
     else
@@ -532,13 +544,7 @@ S_missingterm(pTHX_ char *s)
        if (nl)
            *nl = '\0';
     }
        if (nl)
            *nl = '\0';
     }
-    else if (
-#ifdef EBCDIC
-       iscntrl(PL_multi_close)
-#else
-       PL_multi_close < 32 || PL_multi_close == 127
-#endif
-       ) {
+    else if (isCNTRL(PL_multi_close)) {
        *tmpbuf = '^';
        tmpbuf[1] = (char)toCTRL(PL_multi_close);
        tmpbuf[2] = '\0';
        *tmpbuf = '^';
        tmpbuf[1] = (char)toCTRL(PL_multi_close);
        tmpbuf[2] = '\0';
@@ -556,17 +562,24 @@ S_missingterm(pTHX_ char *s)
 #define FEATURE_IS_ENABLED(name)                                       \
        ((0 != (PL_hints & HINT_LOCALIZE_HH))                           \
            && S_feature_is_enabled(aTHX_ STR_WITH_LEN(name)))
 #define FEATURE_IS_ENABLED(name)                                       \
        ((0 != (PL_hints & HINT_LOCALIZE_HH))                           \
            && S_feature_is_enabled(aTHX_ STR_WITH_LEN(name)))
+/* The longest string we pass in.  */
+#define MAX_FEATURE_LEN (sizeof("switch")-1)
+
 /*
  * S_feature_is_enabled
  * Check whether the named feature is enabled.
  */
 STATIC bool
 /*
  * S_feature_is_enabled
  * Check whether the named feature is enabled.
  */
 STATIC bool
-S_feature_is_enabled(pTHX_ const char *name, STRLEN namelen)
+S_feature_is_enabled(pTHX_ const char *const name, STRLEN namelen)
 {
     dVAR;
     HV * const hinthv = GvHV(PL_hintgv);
 {
     dVAR;
     HV * const hinthv = GvHV(PL_hintgv);
-    char he_name[32] = "feature_";
-    (void) my_strlcpy(&he_name[8], name, 24);
+    char he_name[8 + MAX_FEATURE_LEN] = "feature_";
+
+    PERL_ARGS_ASSERT_FEATURE_IS_ENABLED;
+
+    assert(namelen <= MAX_FEATURE_LEN);
+    memcpy(&he_name[8], name, namelen);
 
     return (hinthv && hv_exists(hinthv, he_name, 8 + namelen));
 }
 
     return (hinthv && hv_exists(hinthv, he_name, 8 + namelen));
 }
@@ -576,14 +589,16 @@ S_feature_is_enabled(pTHX_ const char *name, STRLEN namelen)
  */
 
 void
  */
 
 void
-Perl_deprecate(pTHX_ const char *s)
+Perl_deprecate(pTHX_ const char *const s)
 {
 {
+    PERL_ARGS_ASSERT_DEPRECATE;
+
     if (ckWARN(WARN_DEPRECATED))
        Perl_warner(aTHX_ packWARN(WARN_DEPRECATED), "Use of %s is deprecated", s);
 }
 
 void
     if (ckWARN(WARN_DEPRECATED))
        Perl_warner(aTHX_ packWARN(WARN_DEPRECATED), "Use of %s is deprecated", s);
 }
 
 void
-Perl_deprecate_old(pTHX_ const char *s)
+Perl_deprecate_old(pTHX_ const char *const s)
 {
     /* This function should NOT be called for any new deprecated warnings */
     /* Use Perl_deprecate instead                                         */
 {
     /* This function should NOT be called for any new deprecated warnings */
     /* Use Perl_deprecate instead                                         */
@@ -593,6 +608,8 @@ Perl_deprecate_old(pTHX_ const char *s)
     /* live under the "syntax" category. It is now a top-level category   */
     /* in its own right.                                                  */
 
     /* live under the "syntax" category. It is now a top-level category   */
     /* in its own right.                                                  */
 
+    PERL_ARGS_ASSERT_DEPRECATE_OLD;
+
     if (ckWARN2(WARN_DEPRECATED, WARN_SYNTAX))
        Perl_warner(aTHX_ packWARN2(WARN_DEPRECATED, WARN_SYNTAX),
                        "Use of %s is deprecated", s);
     if (ckWARN2(WARN_DEPRECATED, WARN_SYNTAX))
        Perl_warner(aTHX_ packWARN2(WARN_DEPRECATED, WARN_SYNTAX),
                        "Use of %s is deprecated", s);
@@ -609,6 +626,9 @@ strip_return(SV *sv)
 {
     register const char *s = SvPVX_const(sv);
     register const char * const e = s + SvCUR(sv);
 {
     register const char *s = SvPVX_const(sv);
     register const char * const e = s + SvCUR(sv);
+
+    PERL_ARGS_ASSERT_STRIP_RETURN;
+
     /* outer loop optimized to do nothing if there are no CR-LFs */
     while (s < e) {
        if (*s++ == '\r' && *s == '\n') {
     /* outer loop optimized to do nothing if there are no CR-LFs */
     while (s < e) {
        if (*s++ == '\r' && *s == '\n') {
@@ -685,12 +705,13 @@ Perl_lex_start(pTHX_ SV *line, PerlIO *rsfp, bool new_filter)
 #else
     parser->nexttoke = 0;
 #endif
 #else
     parser->nexttoke = 0;
 #endif
+    parser->error_count = oparser ? oparser->error_count : 0;
     parser->copline = NOLINE;
     parser->lex_state = LEX_NORMAL;
     parser->expect = XSTATE;
     parser->rsfp = rsfp;
     parser->rsfp_filters = (new_filter || !oparser) ? newAV()
     parser->copline = NOLINE;
     parser->lex_state = LEX_NORMAL;
     parser->expect = XSTATE;
     parser->rsfp = rsfp;
     parser->rsfp_filters = (new_filter || !oparser) ? newAV()
-               : (AV*)SvREFCNT_inc(oparser->rsfp_filters);
+               : MUTABLE_AV(SvREFCNT_inc(oparser->rsfp_filters));
 
     Newx(parser->lex_brackstack, 120, char);
     Newx(parser->lex_casestack, 12, char);
 
     Newx(parser->lex_brackstack, 120, char);
     Newx(parser->lex_casestack, 12, char);
@@ -727,13 +748,15 @@ Perl_lex_start(pTHX_ SV *line, PerlIO *rsfp, bool new_filter)
 void
 Perl_parser_free(pTHX_  const yy_parser *parser)
 {
 void
 Perl_parser_free(pTHX_  const yy_parser *parser)
 {
+    PERL_ARGS_ASSERT_PARSER_FREE;
+
     PL_curcop = parser->saved_curcop;
     SvREFCNT_dec(parser->linestr);
 
     if (parser->rsfp == PerlIO_stdin())
        PerlIO_clearerr(parser->rsfp);
     PL_curcop = parser->saved_curcop;
     SvREFCNT_dec(parser->linestr);
 
     if (parser->rsfp == PerlIO_stdin())
        PerlIO_clearerr(parser->rsfp);
-    else if (parser->rsfp && parser->old_parser
-                         && parser->rsfp != parser->old_parser->rsfp)
+    else if (parser->rsfp && (!parser->old_parser ||
+               (parser->old_parser && parser->rsfp != parser->old_parser->rsfp)))
        PerlIO_close(parser->rsfp);
     SvREFCNT_dec(parser->rsfp_filters);
 
        PerlIO_close(parser->rsfp);
     SvREFCNT_dec(parser->rsfp_filters);
 
@@ -776,6 +799,8 @@ S_incline(pTHX_ const char *s)
     const char *n;
     const char *e;
 
     const char *n;
     const char *e;
 
+    PERL_ARGS_ASSERT_INCLINE;
+
     CopLINE_inc(PL_curcop);
     if (*s++ != '#')
        return;
     CopLINE_inc(PL_curcop);
     if (*s++ != '#')
        return;
@@ -797,6 +822,8 @@ S_incline(pTHX_ const char *s)
     n = s;
     while (isDIGIT(*s))
        s++;
     n = s;
     while (isDIGIT(*s))
        s++;
+    if (!SPACE_OR_TAB(*s) && *s != '\r' && *s != '\n' && *s != '\0')
+       return;
     while (SPACE_OR_TAB(*s))
        s++;
     if (*s == '"' && (t = strchr(s+1, '"'))) {
     while (SPACE_OR_TAB(*s))
        s++;
     if (*s == '"' && (t = strchr(s+1, '"'))) {
@@ -817,8 +844,18 @@ S_incline(pTHX_ const char *s)
     if (t - s > 0) {
        const STRLEN len = t - s;
 #ifndef USE_ITHREADS
     if (t - s > 0) {
        const STRLEN len = t - s;
 #ifndef USE_ITHREADS
-       const char * const cf = CopFILE(PL_curcop);
-       STRLEN tmplen = cf ? strlen(cf) : 0;
+       SV *const temp_sv = CopFILESV(PL_curcop);
+       const char *cf;
+       STRLEN tmplen;
+
+       if (temp_sv) {
+           cf = SvPVX(temp_sv);
+           tmplen = SvCUR(temp_sv);
+       } else {
+           cf = NULL;
+           tmplen = 0;
+       }
+
        if (tmplen > 7 && strnEQ(cf, "(eval ", 6)) {
            /* must copy *{"::_<(eval N)[oldfilename:L]"}
             * to *{"::_<newfilename"} */
        if (tmplen > 7 && strnEQ(cf, "(eval ", 6)) {
            /* must copy *{"::_<(eval N)[oldfilename:L]"}
             * to *{"::_<newfilename"} */
@@ -861,8 +898,8 @@ S_incline(pTHX_ const char *s)
                    gv_init(gv2, PL_defstash, tmpbuf2, tmplen2, FALSE);
                    /* adjust ${"::_<newfilename"} to store the new file name */
                    GvSV(gv2) = newSVpvn(tmpbuf2 + 2, tmplen2 - 2);
                    gv_init(gv2, PL_defstash, tmpbuf2, tmplen2, FALSE);
                    /* adjust ${"::_<newfilename"} to store the new file name */
                    GvSV(gv2) = newSVpvn(tmpbuf2 + 2, tmplen2 - 2);
-                   GvHV(gv2) = (HV*)SvREFCNT_inc(GvHV(*gvp));
-                   GvAV(gv2) = (AV*)SvREFCNT_inc(GvAV(*gvp));
+                   GvHV(gv2) = MUTABLE_HV(SvREFCNT_inc(GvHV(*gvp)));
+                   GvAV(gv2) = MUTABLE_AV(SvREFCNT_inc(GvAV(*gvp)));
                }
 
                if (tmpbuf2 != smallbuf) Safefree(tmpbuf2);
                }
 
                if (tmpbuf2 != smallbuf) Safefree(tmpbuf2);
@@ -882,6 +919,8 @@ S_incline(pTHX_ const char *s)
 STATIC char *
 S_skipspace0(pTHX_ register char *s)
 {
 STATIC char *
 S_skipspace0(pTHX_ register char *s)
 {
+    PERL_ARGS_ASSERT_SKIPSPACE0;
+
     s = skipspace(s);
     if (!PL_madskills)
        return s;
     s = skipspace(s);
     if (!PL_madskills)
        return s;
@@ -904,6 +943,8 @@ S_skipspace1(pTHX_ register char *s)
     const char *start = s;
     I32 startoff = start - SvPVX(PL_linestr);
 
     const char *start = s;
     I32 startoff = start - SvPVX(PL_linestr);
 
+    PERL_ARGS_ASSERT_SKIPSPACE1;
+
     s = skipspace(s);
     if (!PL_madskills)
        return s;
     s = skipspace(s);
     if (!PL_madskills)
        return s;
@@ -930,6 +971,8 @@ S_skipspace2(pTHX_ register char *s, SV **svp)
     const I32 bufptroff = PL_bufptr - SvPVX(PL_linestr);
     const I32 startoff = s - SvPVX(PL_linestr);
 
     const I32 bufptroff = PL_bufptr - SvPVX(PL_linestr);
     const I32 startoff = s - SvPVX(PL_linestr);
 
+    PERL_ARGS_ASSERT_SKIPSPACE2;
+
     s = skipspace(s);
     PL_bufptr = SvPVX(PL_linestr) + bufptroff;
     if (!PL_madskills || !svp)
     s = skipspace(s);
     PL_bufptr = SvPVX(PL_linestr) + bufptroff;
     if (!PL_madskills || !svp)
@@ -953,7 +996,7 @@ S_skipspace2(pTHX_ register char *s, SV **svp)
 #endif
 
 STATIC void
 #endif
 
 STATIC void
-S_update_debugger_info(pTHX_ SV *orig_sv, const char *buf, STRLEN len)
+S_update_debugger_info(pTHX_ SV *orig_sv, const char *const buf, STRLEN len)
 {
     AV *av = CopFILEAVx(PL_curcop);
     if (av) {
 {
     AV *av = CopFILEAVx(PL_curcop);
     if (av) {
@@ -982,11 +1025,14 @@ S_skipspace(pTHX_ register char *s)
     int curoff;
     int startoff = s - SvPVX(PL_linestr);
 
     int curoff;
     int startoff = s - SvPVX(PL_linestr);
 
+    PERL_ARGS_ASSERT_SKIPSPACE;
+
     if (PL_skipwhite) {
        sv_free(PL_skipwhite);
        PL_skipwhite = 0;
     }
 #endif
     if (PL_skipwhite) {
        sv_free(PL_skipwhite);
        PL_skipwhite = 0;
     }
 #endif
+    PERL_ARGS_ASSERT_SKIPSPACE;
 
     if (PL_lex_formbrack && PL_lex_brackets <= PL_lex_formbrack) {
        while (s < PL_bufend && SPACE_OR_TAB(*s))
 
     if (PL_lex_formbrack && PL_lex_brackets <= PL_lex_formbrack) {
        while (s < PL_bufend && SPACE_OR_TAB(*s))
@@ -1069,17 +1115,17 @@ S_skipspace(pTHX_ register char *s)
            }
            else if (PL_minus_n) {
 #ifdef PERL_MAD
            }
            else if (PL_minus_n) {
 #ifdef PERL_MAD
-               sv_catpvn(PL_linestr, ";}", 2);
+               sv_catpvs(PL_linestr, ";}");
 #else
 #else
-               sv_setpvn(PL_linestr, ";}", 2);
+               sv_setpvs(PL_linestr, ";}");
 #endif
                PL_minus_n = 0;
            }
            else
 #ifdef PERL_MAD
 #endif
                PL_minus_n = 0;
            }
            else
 #ifdef PERL_MAD
-               sv_catpvn(PL_linestr,";", 1);
+               sv_catpvs(PL_linestr,";");
 #else
 #else
-               sv_setpvn(PL_linestr,";", 1);
+               sv_setpvs(PL_linestr,";");
 #endif
 
            /* reset variables for next time we lex */
 #endif
 
            /* reset variables for next time we lex */
@@ -1092,16 +1138,14 @@ S_skipspace(pTHX_ register char *s)
            PL_bufend = SvPVX(PL_linestr) + SvCUR(PL_linestr);
            PL_last_lop = PL_last_uni = NULL;
 
            PL_bufend = SvPVX(PL_linestr) + SvCUR(PL_linestr);
            PL_last_lop = PL_last_uni = NULL;
 
-           /* Close the filehandle.  Could be from -P preprocessor,
+           /* Close the filehandle.  Could be from
             * STDIN, or a regular file.  If we were reading code from
             * STDIN (because the commandline held no -e or filename)
             * then we don't close it, we reset it so the code can
             * read from STDIN too.
             */
 
             * STDIN, or a regular file.  If we were reading code from
             * STDIN (because the commandline held no -e or filename)
             * then we don't close it, we reset it so the code can
             * read from STDIN too.
             */
 
-           if (PL_preprocess && !PL_in_eval)
-               (void)PerlProc_pclose(PL_rsfp);
-           else if ((PerlIO*)PL_rsfp == PerlIO_stdin())
+           if ((PerlIO*)PL_rsfp == PerlIO_stdin())
                PerlIO_clearerr(PL_rsfp);
            else
                (void)PerlIO_close(PL_rsfp);
                PerlIO_clearerr(PL_rsfp);
            else
                (void)PerlIO_close(PL_rsfp);
@@ -1131,7 +1175,7 @@ S_skipspace(pTHX_ register char *s)
        /* debugger active and we're not compiling the debugger code,
         * so store the line into the debugger's array of lines
         */
        /* debugger active and we're not compiling the debugger code,
         * so store the line into the debugger's array of lines
         */
-       if (PERLDB_LINE && PL_curstash != PL_debstash)
+       if ((PERLDB_LINE || PERLDB_SAVESRC) && PL_curstash != PL_debstash)
            update_debugger_info(NULL, PL_bufptr, PL_bufend - PL_bufptr);
     }
 
            update_debugger_info(NULL, PL_bufptr, PL_bufend - PL_bufptr);
     }
 
@@ -1201,7 +1245,10 @@ STATIC I32
 S_lop(pTHX_ I32 f, int x, char *s)
 {
     dVAR;
 S_lop(pTHX_ I32 f, int x, char *s)
 {
     dVAR;
-    yylval.ival = f;
+
+    PERL_ARGS_ASSERT_LOP;
+
+    pl_yylval.ival = f;
     CLINE;
     PL_expect = x;
     PL_bufptr = s;
     CLINE;
     PL_expect = x;
     PL_bufptr = s;
@@ -1268,7 +1315,7 @@ S_curmad(pTHX_ char slot, SV *sv)
        where = &PL_nexttoke[PL_curforce].next_mad;
 
     if (PL_faketokens)
        where = &PL_nexttoke[PL_curforce].next_mad;
 
     if (PL_faketokens)
-       sv_setpvn(sv, "", 0);
+       sv_setpvs(sv, "");
     else {
        if (!IN_BYTES) {
            if (UTF && is_utf8_string((U8*)SvPVX(sv), SvCUR(sv)))
     else {
        if (!IN_BYTES) {
            if (UTF && is_utf8_string((U8*)SvPVX(sv), SvCUR(sv)))
@@ -1282,7 +1329,7 @@ S_curmad(pTHX_ char slot, SV *sv)
     /* keep a slot open for the head of the list? */
     if (slot != '_' && *where && (*where)->mad_key == '^') {
        (*where)->mad_key = slot;
     /* keep a slot open for the head of the list? */
     if (slot != '_' && *where && (*where)->mad_key == '^') {
        (*where)->mad_key = slot;
-       sv_free((SV*)((*where)->mad_val));
+       sv_free(MUTABLE_SV(((*where)->mad_val)));
        (*where)->mad_val = (void*)sv;
     }
     else
        (*where)->mad_val = (void*)sv;
     }
     else
@@ -1306,6 +1353,12 @@ STATIC void
 S_force_next(pTHX_ I32 type)
 {
     dVAR;
 S_force_next(pTHX_ I32 type)
 {
     dVAR;
+#ifdef DEBUGGING
+    if (DEBUG_T_TEST) {
+        PerlIO_printf(Perl_debug_log, "### forced token:\n");
+       tokereport(type, &NEXTVAL_NEXTTOKE);
+    }
+#endif
 #ifdef PERL_MAD
     if (PL_curforce < 0)
        start_force(PL_lasttoke);
 #ifdef PERL_MAD
     if (PL_curforce < 0)
        start_force(PL_lasttoke);
@@ -1327,12 +1380,14 @@ S_force_next(pTHX_ I32 type)
 }
 
 STATIC SV *
 }
 
 STATIC SV *
-S_newSV_maybe_utf8(pTHX_ const char *start, STRLEN len)
+S_newSV_maybe_utf8(pTHX_ const char *const start, STRLEN len)
 {
     dVAR;
 {
     dVAR;
-    SV * const sv = newSVpvn(start,len);
-    if (UTF && !IN_BYTES && is_utf8_string((const U8*)start, len))
-       SvUTF8_on(sv);
+    SV * const sv = newSVpvn_utf8(start, len,
+                                 !IN_BYTES
+                                 && UTF
+                                 && !is_ascii_string((const U8*)start, len)
+                                 && is_utf8_string((const U8*)start, len));
     return sv;
 }
 
     return sv;
 }
 
@@ -1360,6 +1415,8 @@ S_force_word(pTHX_ register char *start, int token, int check_keyword, int allow
     register char *s;
     STRLEN len;
 
     register char *s;
     STRLEN len;
 
+    PERL_ARGS_ASSERT_FORCE_WORD;
+
     start = SKIPSPACE1(start);
     s = start;
     if (isIDFIRST_lazy_if(s,UTF) ||
     start = SKIPSPACE1(start);
     s = start;
     if (isIDFIRST_lazy_if(s,UTF) ||
@@ -1404,6 +1461,9 @@ STATIC void
 S_force_ident(pTHX_ register const char *s, int kind)
 {
     dVAR;
 S_force_ident(pTHX_ register const char *s, int kind)
 {
     dVAR;
+
+    PERL_ARGS_ASSERT_FORCE_IDENT;
+
     if (*s) {
        const STRLEN len = strlen(s);
        OP* const o = (OP*)newSVOP(OP_CONST, 0, newSVpvn(s, len));
     if (*s) {
        const STRLEN len = strlen(s);
        OP* const o = (OP*)newSVOP(OP_CONST, 0, newSVpvn(s, len));
@@ -1436,6 +1496,9 @@ Perl_str_to_version(pTHX_ SV *sv)
     const char *start = SvPV_const(sv,len);
     const char * const end = start + len;
     const bool utf = SvUTF8(sv) ? TRUE : FALSE;
     const char *start = SvPV_const(sv,len);
     const char * const end = start + len;
     const bool utf = SvUTF8(sv) ? TRUE : FALSE;
+
+    PERL_ARGS_ASSERT_STR_TO_VERSION;
+
     while (start < end) {
        STRLEN skip;
        UV n;
     while (start < end) {
        STRLEN skip;
        UV n;
@@ -1470,6 +1533,8 @@ S_force_version(pTHX_ char *s, int guessing)
     I32 startoff = s - SvPVX(PL_linestr);
 #endif
 
     I32 startoff = s - SvPVX(PL_linestr);
 #endif
 
+    PERL_ARGS_ASSERT_FORCE_VERSION;
+
     s = SKIPSPACE1(s);
 
     d = s;
     s = SKIPSPACE1(s);
 
     d = s;
@@ -1486,8 +1551,8 @@ S_force_version(pTHX_ char *s, int guessing)
 #endif
         if (*d == ';' || isSPACE(*d) || *d == '}' || !*d) {
            SV *ver;
 #endif
         if (*d == ';' || isSPACE(*d) || *d == '}' || !*d) {
            SV *ver;
-            s = scan_num(s, &yylval);
-            version = yylval.opval;
+            s = scan_num(s, &pl_yylval);
+            version = pl_yylval.opval;
            ver = cSVOPx(version)->op_sv;
            if (SvPOK(ver) && !SvNIOK(ver)) {
                SvUPGRADE(ver, SVt_PVNV);
            ver = cSVOPx(version)->op_sv;
            if (SvPOK(ver) && !SvNIOK(ver)) {
                SvUPGRADE(ver, SVt_PVNV);
@@ -1540,6 +1605,8 @@ S_tokeq(pTHX_ SV *sv)
     STRLEN len = 0;
     SV *pv = sv;
 
     STRLEN len = 0;
     SV *pv = sv;
 
+    PERL_ARGS_ASSERT_TOKEQ;
+
     if (!SvLEN(sv))
        goto finish;
 
     if (!SvLEN(sv))
        goto finish;
 
@@ -1553,9 +1620,7 @@ S_tokeq(pTHX_ SV *sv)
        goto finish;
     d = s;
     if ( PL_hints & HINT_NEW_STRING ) {
        goto finish;
     d = s;
     if ( PL_hints & HINT_NEW_STRING ) {
-       pv = sv_2mortal(newSVpvn(SvPVX_const(pv), len));
-       if (SvUTF8(sv))
-           SvUTF8_on(pv);
+       pv = newSVpvn_flags(SvPVX_const(pv), len, SVs_TEMP | SvUTF8(sv));
     }
     while (s < send) {
        if (*s == '\\') {
     }
     while (s < send) {
        if (*s == '\\') {
@@ -1568,7 +1633,7 @@ S_tokeq(pTHX_ SV *sv)
     SvCUR_set(sv, d - SvPVX_const(sv));
   finish:
     if ( PL_hints & HINT_NEW_STRING )
     SvCUR_set(sv, d - SvPVX_const(sv));
   finish:
     if ( PL_hints & HINT_NEW_STRING )
-       return new_constant(NULL, 0, "q", sv, pv, "q");
+       return new_constant(NULL, 0, "q", sv, pv, "q", 1);
     return sv;
 }
 
     return sv;
 }
 
@@ -1590,10 +1655,10 @@ S_tokeq(pTHX_ SV *sv)
 
 /*
  * S_sublex_start
 
 /*
  * S_sublex_start
- * Assumes that yylval.ival is the op we're creating (e.g. OP_LCFIRST).
+ * Assumes that pl_yylval.ival is the op we're creating (e.g. OP_LCFIRST).
  *
  * Pattern matching will set PL_lex_op to the pattern-matching op to
  *
  * Pattern matching will set PL_lex_op to the pattern-matching op to
- * make (we return THING if yylval.ival is OP_NULL, PMFUNC otherwise).
+ * make (we return THING if pl_yylval.ival is OP_NULL, PMFUNC otherwise).
  *
  * OP_CONST and OP_READLINE are easy--just make the new op and return.
  *
  *
  * OP_CONST and OP_READLINE are easy--just make the new op and return.
  *
@@ -1608,10 +1673,10 @@ STATIC I32
 S_sublex_start(pTHX)
 {
     dVAR;
 S_sublex_start(pTHX)
 {
     dVAR;
-    register const I32 op_type = yylval.ival;
+    register const I32 op_type = pl_yylval.ival;
 
     if (op_type == OP_NULL) {
 
     if (op_type == OP_NULL) {
-       yylval.opval = PL_lex_op;
+       pl_yylval.opval = PL_lex_op;
        PL_lex_op = NULL;
        return THING;
     }
        PL_lex_op = NULL;
        return THING;
     }
@@ -1622,13 +1687,11 @@ S_sublex_start(pTHX)
            /* Overloaded constants, nothing fancy: Convert to SVt_PV: */
            STRLEN len;
            const char * const p = SvPV_const(sv, len);
            /* Overloaded constants, nothing fancy: Convert to SVt_PV: */
            STRLEN len;
            const char * const p = SvPV_const(sv, len);
-           SV * const nsv = newSVpvn(p, len);
-           if (SvUTF8(sv))
-               SvUTF8_on(nsv);
+           SV * const nsv = newSVpvn_flags(p, len, SvUTF8(sv));
            SvREFCNT_dec(sv);
            sv = nsv;
        }
            SvREFCNT_dec(sv);
            sv = nsv;
        }
-       yylval.opval = (OP*)newSVOP(op_type, 0, sv);
+       pl_yylval.opval = (OP*)newSVOP(op_type, 0, sv);
        PL_lex_stuff = NULL;
        /* Allow <FH> // "foo" */
        if (op_type == OP_READLINE)
        PL_lex_stuff = NULL;
        /* Allow <FH> // "foo" */
        if (op_type == OP_READLINE)
@@ -1638,7 +1701,7 @@ S_sublex_start(pTHX)
     else if (op_type == OP_BACKTICK && PL_lex_op) {
        /* readpipe() vas overriden */
        cSVOPx(cLISTOPx(cUNOPx(PL_lex_op)->op_first)->op_first->op_sibling)->op_sv = tokeq(PL_lex_stuff);
     else if (op_type == OP_BACKTICK && PL_lex_op) {
        /* readpipe() vas overriden */
        cSVOPx(cLISTOPx(cUNOPx(PL_lex_op)->op_first)->op_first->op_sibling)->op_sv = tokeq(PL_lex_stuff);
-       yylval.opval = PL_lex_op;
+       pl_yylval.opval = PL_lex_op;
        PL_lex_op = NULL;
        PL_lex_stuff = NULL;
        return THING;
        PL_lex_op = NULL;
        PL_lex_stuff = NULL;
        return THING;
@@ -1651,7 +1714,7 @@ S_sublex_start(pTHX)
 
     PL_expect = XTERM;
     if (PL_lex_op) {
 
     PL_expect = XTERM;
     if (PL_lex_op) {
-       yylval.opval = PL_lex_op;
+       pl_yylval.opval = PL_lex_op;
        PL_lex_op = NULL;
        return PMFUNC;
     }
        PL_lex_op = NULL;
        return PMFUNC;
     }
@@ -1735,7 +1798,7 @@ S_sublex_done(pTHX)
        if (SvUTF8(PL_linestr))
            SvUTF8_on(sv);
        PL_expect = XOPERATOR;
        if (SvUTF8(PL_linestr))
            SvUTF8_on(sv);
        PL_expect = XOPERATOR;
-       yylval.opval = (OP*)newSVOP(OP_CONST, 0, sv);
+       pl_yylval.opval = (OP*)newSVOP(OP_CONST, 0, sv);
        return THING;
     }
 
        return THING;
     }
 
@@ -1781,7 +1844,7 @@ S_sublex_done(pTHX)
                PL_thiswhite = 0;
            }
            if (PL_thistoken)
                PL_thiswhite = 0;
            }
            if (PL_thistoken)
-               sv_setpvn(PL_thistoken,"",0);
+               sv_setpvs(PL_thistoken,"");
            else
                PL_realtokenstart = -1;
        }
            else
                PL_realtokenstart = -1;
        }
@@ -1808,7 +1871,7 @@ S_sublex_done(pTHX)
   Returns a pointer to the character scanned up to. If this is
   advanced from the start pointer supplied (i.e. if anything was
   successfully parsed), will leave an OP for the substring scanned
   Returns a pointer to the character scanned up to. If this is
   advanced from the start pointer supplied (i.e. if anything was
   successfully parsed), will leave an OP for the substring scanned
-  in yylval. Caller must intuit reason for not parsing further
+  in pl_yylval. Caller must intuit reason for not parsing further
   by looking at the next characters herself.
 
   In patterns:
   by looking at the next characters herself.
 
   In patterns:
@@ -1869,7 +1932,9 @@ S_sublex_done(pTHX)
                  handle \cV (control characters)
                  handle printf-style backslashes (\f, \r, \n, etc)
              } (end switch)
                  handle \cV (control characters)
                  handle printf-style backslashes (\f, \r, \n, etc)
              } (end switch)
+             continue
          } (end if backslash)
          } (end if backslash)
+          handle regular character
     } (end while character to read)
                
 */
     } (end while character to read)
                
 */
@@ -1879,19 +1944,40 @@ S_scan_const(pTHX_ char *start)
 {
     dVAR;
     register char *send = PL_bufend;           /* end of the constant */
 {
     dVAR;
     register char *send = PL_bufend;           /* end of the constant */
-    SV *sv = newSV(send - start);              /* sv for the constant */
+    SV *sv = newSV(send - start);              /* sv for the constant.  See
+                                                  note below on sizing. */
     register char *s = start;                  /* start of the constant */
     register char *d = SvPVX(sv);              /* destination for copies */
     bool dorange = FALSE;                      /* are we in a translit range? */
     bool didrange = FALSE;                     /* did we just finish a range? */
     I32  has_utf8 = FALSE;                     /* Output constant is UTF8 */
     register char *s = start;                  /* start of the constant */
     register char *d = SvPVX(sv);              /* destination for copies */
     bool dorange = FALSE;                      /* are we in a translit range? */
     bool didrange = FALSE;                     /* did we just finish a range? */
     I32  has_utf8 = FALSE;                     /* Output constant is UTF8 */
-    I32  this_utf8 = UTF;                      /* The source string is assumed to be UTF8 */
+    I32  this_utf8 = UTF;                      /* Is the source string assumed
+                                                  to be UTF8?  But, this can
+                                                  show as true when the source
+                                                  isn't utf8, as for example
+                                                  when it is entirely composed
+                                                  of hex constants */
+
+    /* Note on sizing:  The scanned constant is placed into sv, which is
+     * initialized by newSV() assuming one byte of output for every byte of
+     * input.  This routine expects newSV() to allocate an extra byte for a
+     * trailing NUL, which this routine will append if it gets to the end of
+     * the input.  There may be more bytes of input than output (eg., \N{LATIN
+     * CAPITAL LETTER A}), or more output than input if the constant ends up
+     * recoded to utf8, but each time a construct is found that might increase
+     * the needed size, SvGROW() is called.  Its size parameter each time is
+     * based on the best guess estimate at the time, namely the length used so
+     * far, plus the length the current construct will occupy, plus room for
+     * the trailing NUL, plus one byte for every input byte still unscanned */ 
+
     UV uv;
 #ifdef EBCDIC
     UV literal_endpoint = 0;
     bool native_range = TRUE; /* turned to FALSE if the first endpoint is Unicode. */
 #endif
 
     UV uv;
 #ifdef EBCDIC
     UV literal_endpoint = 0;
     bool native_range = TRUE; /* turned to FALSE if the first endpoint is Unicode. */
 #endif
 
+    PERL_ARGS_ASSERT_SCAN_CONST;
+
     if (PL_lex_inwhat == OP_TRANS && PL_sublex_info.sub_op) {
        /* If we are doing a trans and we know we want UTF8 set expectation */
        has_utf8   = PL_sublex_info.sub_op->op_private & (OPpTRANS_FROM_UTF|OPpTRANS_TO_UTF);
     if (PL_lex_inwhat == OP_TRANS && PL_sublex_info.sub_op) {
        /* If we are doing a trans and we know we want UTF8 set expectation */
        has_utf8   = PL_sublex_info.sub_op->op_private & (OPpTRANS_FROM_UTF|OPpTRANS_TO_UTF);
@@ -2106,8 +2192,13 @@ S_scan_const(pTHX_ char *start)
        else if (*s == '$') {
            if (!PL_lex_inpat)  /* not a regexp, so $ must be var */
                break;
        else if (*s == '$') {
            if (!PL_lex_inpat)  /* not a regexp, so $ must be var */
                break;
-           if (s + 1 < send && !strchr("()| \r\n\t", s[1]))
+           if (s + 1 < send && !strchr("()| \r\n\t", s[1])) {
+               if (s[1] == '\\' && ckWARN(WARN_AMBIGUOUS)) {
+                   Perl_warner(aTHX_ packWARN(WARN_AMBIGUOUS),
+                               "Possible unintended interpolation of $\\ in regex");
+               }
                break;          /* in regexp, $ might be tail anchor */
                break;          /* in regexp, $ might be tail anchor */
+            }
        }
 
        /* End of else if chain - OP_TRANS rejoin rest */
        }
 
        /* End of else if chain - OP_TRANS rejoin rest */
@@ -2158,18 +2249,18 @@ S_scan_const(pTHX_ char *start)
                    goto default_action;
                }
 
                    goto default_action;
                }
 
-           /* \132 indicates an octal constant */
+           /* eg. \132 indicates the octal constant 0x132 */
            case '0': case '1': case '2': case '3':
            case '4': case '5': case '6': case '7':
                {
                     I32 flags = 0;
                     STRLEN len = 3;
            case '0': case '1': case '2': case '3':
            case '4': case '5': case '6': case '7':
                {
                     I32 flags = 0;
                     STRLEN len = 3;
-                   uv = grok_oct(s, &len, &flags, NULL);
+                   uv = NATIVE_TO_UNI(grok_oct(s, &len, &flags, NULL));
                    s += len;
                }
                goto NUM_ESCAPE_INSERT;
 
                    s += len;
                }
                goto NUM_ESCAPE_INSERT;
 
-           /* \x24 indicates a hex constant */
+           /* eg. \x24 indicates the hex constant 0x24 */
            case 'x':
                ++s;
                if (*s == '{') {
            case 'x':
                ++s;
                if (*s == '{') {
@@ -2184,67 +2275,47 @@ S_scan_const(pTHX_ char *start)
                        continue;
                    }
                     len = e - s;
                        continue;
                    }
                     len = e - s;
-                   uv = grok_hex(s, &len, &flags, NULL);
+                   uv = NATIVE_TO_UNI(grok_hex(s, &len, &flags, NULL));
                    s = e + 1;
                }
                else {
                    {
                        STRLEN len = 2;
                         I32 flags = PERL_SCAN_DISALLOW_PREFIX;
                    s = e + 1;
                }
                else {
                    {
                        STRLEN len = 2;
                         I32 flags = PERL_SCAN_DISALLOW_PREFIX;
-                       uv = grok_hex(s, &len, &flags, NULL);
+                       uv = NATIVE_TO_UNI(grok_hex(s, &len, &flags, NULL));
                        s += len;
                    }
                }
 
              NUM_ESCAPE_INSERT:
                        s += len;
                    }
                }
 
              NUM_ESCAPE_INSERT:
-               /* Insert oct or hex escaped character.
-                * There will always enough room in sv since such
-                * escapes will be longer than any UTF-8 sequence
-                * they can end up as. */
+               /* Insert oct, hex, or \N{U+...} escaped character.  There will
+                * always be enough room in sv since such escapes will be
+                * longer than any UTF-8 sequence they can end up as, except if
+                * they force us to recode the rest of the string into utf8 */
                
                
-               /* We need to map to chars to ASCII before doing the tests
-                  to cover EBCDIC
-               */
-               if (!UNI_IS_INVARIANT(NATIVE_TO_UNI(uv))) {
+               /* Here uv is the ordinal of the next character being added in
+                * unicode (converted from native).  (It has to be done before
+                * here because \N is interpreted as unicode, and oct and hex
+                * as native.) */
+               if (!UNI_IS_INVARIANT(uv)) {
                    if (!has_utf8 && uv > 255) {
                    if (!has_utf8 && uv > 255) {
-                       /* Might need to recode whatever we have
-                        * accumulated so far if it contains any
-                        * hibit chars.
-                        *
-                        * (Can't we keep track of that and avoid
-                        *  this rescan? --jhi)
-                        */
-                       int hicount = 0;
-                       U8 *c;
-                       for (c = (U8 *) SvPVX(sv); c < (U8 *)d; c++) {
-                           if (!NATIVE_IS_INVARIANT(*c)) {
-                               hicount++;
-                           }
-                       }
-                       if (hicount) {
-                           const STRLEN offset = d - SvPVX_const(sv);
-                           U8 *src, *dst;
-                           d = SvGROW(sv, SvLEN(sv) + hicount + 1) + offset;
-                           src = (U8 *)d - 1;
-                           dst = src+hicount;
-                           d  += hicount;
-                           while (src >= (const U8 *)SvPVX_const(sv)) {
-                               if (!NATIVE_IS_INVARIANT(*src)) {
-                                   const U8 ch = NATIVE_TO_ASCII(*src);
-                                   *dst-- = (U8)UTF8_EIGHT_BIT_LO(ch);
-                                   *dst-- = (U8)UTF8_EIGHT_BIT_HI(ch);
-                               }
-                               else {
-                                   *dst-- = *src;
-                               }
-                               src--;
-                           }
-                        }
+                       /* Might need to recode whatever we have accumulated so
+                        * far if it contains any chars variant in utf8 or
+                        * utf-ebcdic. */
+                         
+                       SvCUR_set(sv, d - SvPVX_const(sv));
+                       SvPOK_on(sv);
+                       *d = '\0';
+                       /* See Note on sizing above.  */
+                       sv_utf8_upgrade_flags_grow(sv,
+                                       SV_GMAGIC|SV_FORCE_UTF8_UPGRADE,
+                                       UNISKIP(uv) + (STRLEN)(send - s) + 1);
+                       d = SvPVX(sv) + SvCUR(sv);
+                       has_utf8 = TRUE;
                     }
 
                     }
 
-                    if (has_utf8 || uv > 255) {
-                       d = (char*)uvchr_to_utf8((U8*)d, uv);
-                       has_utf8 = TRUE;
+                    if (has_utf8) {
+                       d = (char*)uvuni_to_utf8((U8*)d, uv);
                        if (PL_lex_inwhat == OP_TRANS &&
                            PL_sublex_info.sub_op) {
                            PL_sublex_info.sub_op->op_private |=
                        if (PL_lex_inwhat == OP_TRANS &&
                            PL_sublex_info.sub_op) {
                            PL_sublex_info.sub_op->op_private |=
@@ -2265,7 +2336,8 @@ S_scan_const(pTHX_ char *start)
                }
                continue;
 
                }
                continue;
 
-           /* \N{LATIN SMALL LETTER A} is a named character */
+           /* \N{LATIN SMALL LETTER A} is a named character, and so is
+            * \N{U+0041} */
            case 'N':
                ++s;
                if (*s == '{') {
            case 'N':
                ++s;
                if (*s == '{') {
@@ -2273,7 +2345,6 @@ S_scan_const(pTHX_ char *start)
                    SV *res;
                    STRLEN len;
                    const char *str;
                    SV *res;
                    STRLEN len;
                    const char *str;
-                   SV *type;
 
                    if (!e) {
                        yyerror("Missing right brace on \\N{}");
 
                    if (!e) {
                        yyerror("Missing right brace on \\N{}");
@@ -2281,7 +2352,8 @@ S_scan_const(pTHX_ char *start)
                        goto cont_scan;
                    }
                    if (e > s + 2 && s[1] == 'U' && s[2] == '+') {
                        goto cont_scan;
                    }
                    if (e > s + 2 && s[1] == 'U' && s[2] == '+') {
-                       /* \N{U+...} */
+                       /* \N{U+...} The ... is a unicode value even on EBCDIC
+                        * machines */
                        I32 flags = PERL_SCAN_ALLOW_UNDERSCORES |
                          PERL_SCAN_DISALLOW_PREFIX;
                        s += 3;
                        I32 flags = PERL_SCAN_ALLOW_UNDERSCORES |
                          PERL_SCAN_DISALLOW_PREFIX;
                        s += 3;
@@ -2294,10 +2366,8 @@ S_scan_const(pTHX_ char *start)
                        goto NUM_ESCAPE_INSERT;
                    }
                    res = newSVpvn(s + 1, e - s - 1);
                        goto NUM_ESCAPE_INSERT;
                    }
                    res = newSVpvn(s + 1, e - s - 1);
-                   type = newSVpvn(s - 2,e - s + 3);
                    res = new_constant( NULL, 0, "charnames",
                    res = new_constant( NULL, 0, "charnames",
-                                       res, NULL, SvPVX(type) );
-                   SvREFCNT_dec(type);         
+                                       res, NULL, s - 2, e - s + 3 );
                    if (has_utf8)
                        sv_utf8_upgrade(res);
                    str = SvPV_const(res,len);
                    if (has_utf8)
                        sv_utf8_upgrade(res);
                    str = SvPV_const(res,len);
@@ -2321,22 +2391,24 @@ S_scan_const(pTHX_ char *start)
                         }
                    }
 #endif
                         }
                    }
 #endif
+                   /* If destination is not in utf8 but this new character is,
+                    * recode the dest to utf8 */
                    if (!has_utf8 && SvUTF8(res)) {
                    if (!has_utf8 && SvUTF8(res)) {
-                       const char * const ostart = SvPVX_const(sv);
-                       SvCUR_set(sv, d - ostart);
+                       SvCUR_set(sv, d - SvPVX_const(sv));
                        SvPOK_on(sv);
                        *d = '\0';
                        SvPOK_on(sv);
                        *d = '\0';
-                       sv_utf8_upgrade(sv);
-                       /* this just broke our allocation above... */
-                       SvGROW(sv, (STRLEN)(send - start));
+                       /* See Note on sizing above.  */
+                       sv_utf8_upgrade_flags_grow(sv,
+                                           SV_GMAGIC|SV_FORCE_UTF8_UPGRADE,
+                                           len + (STRLEN)(send - s) + 1);
                        d = SvPVX(sv) + SvCUR(sv);
                        has_utf8 = TRUE;
                        d = SvPVX(sv) + SvCUR(sv);
                        has_utf8 = TRUE;
-                   }
-                   if (len > (STRLEN)(e - s + 4)) { /* I _guess_ 4 is \N{} --jhi */
-                       const char * const odest = SvPVX_const(sv);
+                   } else if (len > (STRLEN)(e - s + 4)) { /* I _guess_ 4 is \N{} --jhi */
 
 
-                       SvGROW(sv, (SvLEN(sv) + len - (e - s + 4)));
-                       d = SvPVX(sv) + (d - odest);
+                       /* See Note on sizing above.  (NOTE: SvCUR() is not set
+                        * correctly here). */
+                       const STRLEN off = d - SvPVX_const(sv);
+                       d = SvGROW(sv, off + len + (STRLEN)(send - s) + 1) + off;
                    }
 #ifdef EBCDIC
                    if (!dorange)
                    }
 #ifdef EBCDIC
                    if (!dorange)
@@ -2401,20 +2473,41 @@ S_scan_const(pTHX_ char *start)
 #endif
 
     default_action:
 #endif
 
     default_action:
-       /* If we started with encoded form, or already know we want it
-          and then encode the next character */
-       if ((has_utf8 || this_utf8) && !NATIVE_IS_INVARIANT((U8)(*s))) {
+       /* If we started with encoded form, or already know we want it,
+          then encode the next character */
+       if (! NATIVE_IS_INVARIANT((U8)(*s)) && (this_utf8 || has_utf8)) {
            STRLEN len  = 1;
            STRLEN len  = 1;
+
+
+           /* One might think that it is wasted effort in the case of the
+            * source being utf8 (this_utf8 == TRUE) to take the next character
+            * in the source, convert it to an unsigned value, and then convert
+            * it back again.  But the source has not been validated here.  The
+            * routine that does the conversion checks for errors like
+            * malformed utf8 */
+
            const UV nextuv   = (this_utf8) ? utf8n_to_uvchr((U8*)s, send - s, &len, 0) : (UV) ((U8) *s);
            const STRLEN need = UNISKIP(NATIVE_TO_UNI(nextuv));
            const UV nextuv   = (this_utf8) ? utf8n_to_uvchr((U8*)s, send - s, &len, 0) : (UV) ((U8) *s);
            const STRLEN need = UNISKIP(NATIVE_TO_UNI(nextuv));
-           s += len;
-           if (need > len) {
-               /* encoded value larger than old, need extra space (NOTE: SvCUR() not set here) */
+           if (!has_utf8) {
+               SvCUR_set(sv, d - SvPVX_const(sv));
+               SvPOK_on(sv);
+               *d = '\0';
+               /* See Note on sizing above.  */
+               sv_utf8_upgrade_flags_grow(sv,
+                                       SV_GMAGIC|SV_FORCE_UTF8_UPGRADE,
+                                       need + (STRLEN)(send - s) + 1);
+               d = SvPVX(sv) + SvCUR(sv);
+               has_utf8 = TRUE;
+           } else if (need > len) {
+               /* encoded value larger than old, may need extra space (NOTE:
+                * SvCUR() is not set correctly here).   See Note on sizing
+                * above.  */
                const STRLEN off = d - SvPVX_const(sv);
                const STRLEN off = d - SvPVX_const(sv);
-               d = SvGROW(sv, SvLEN(sv) + (need-len)) + off;
+               d = SvGROW(sv, off + need + (STRLEN)(send - s) + 1) + off;
            }
            }
+           s += len;
+
            d = (char*)uvchr_to_utf8((U8*)d, nextuv);
            d = (char*)uvchr_to_utf8((U8*)d, nextuv);
-           has_utf8 = TRUE;
 #ifdef EBCDIC
            if (uv > 255 && !dorange)
                native_range = FALSE;
 #ifdef EBCDIC
            if (uv > 255 && !dorange)
                native_range = FALSE;
@@ -2450,19 +2543,29 @@ S_scan_const(pTHX_ char *start)
        SvPV_shrink_to_cur(sv);
     }
 
        SvPV_shrink_to_cur(sv);
     }
 
-    /* return the substring (via yylval) only if we parsed anything */
+    /* return the substring (via pl_yylval) only if we parsed anything */
     if (s > PL_bufptr) {
     if (s > PL_bufptr) {
-       if ( PL_hints & ( PL_lex_inpat ? HINT_NEW_RE : HINT_NEW_STRING ) )
-           sv = new_constant(start, s - start,
-                             (const char *)(PL_lex_inpat ? "qr" : "q"),
-                             sv, NULL,
-                             (const char *)
-                             (( PL_lex_inwhat == OP_TRANS
-                                ? "tr"
-                                : ( (PL_lex_inwhat == OP_SUBST && !PL_lex_inpat)
-                                    ? "s"
-                                    : "qq"))));
-       yylval.opval = (OP*)newSVOP(OP_CONST, 0, sv);
+       if ( PL_hints & ( PL_lex_inpat ? HINT_NEW_RE : HINT_NEW_STRING ) ) {
+           const char *const key = PL_lex_inpat ? "qr" : "q";
+           const STRLEN keylen = PL_lex_inpat ? 2 : 1;
+           const char *type;
+           STRLEN typelen;
+
+           if (PL_lex_inwhat == OP_TRANS) {
+               type = "tr";
+               typelen = 2;
+           } else if (PL_lex_inwhat == OP_SUBST && !PL_lex_inpat) {
+               type = "s";
+               typelen = 1;
+           } else  {
+               type = "qq";
+               typelen = 2;
+           }
+
+           sv = S_new_constant(aTHX_ start, s - start, key, keylen, sv, NULL,
+                               type, typelen);
+       }
+       pl_yylval.opval = (OP*)newSVOP(OP_CONST, 0, sv);
     } else
        SvREFCNT_dec(sv);
     return s;
     } else
        SvREFCNT_dec(sv);
     return s;
@@ -2493,6 +2596,9 @@ STATIC int
 S_intuit_more(pTHX_ register char *s)
 {
     dVAR;
 S_intuit_more(pTHX_ register char *s)
 {
     dVAR;
+
+    PERL_ARGS_ASSERT_INTUIT_MORE;
+
     if (PL_lex_brackets)
        return TRUE;
     if (*s == '-' && s[1] == '>' && (s[2] == '[' || s[2] == '{'))
     if (PL_lex_brackets)
        return TRUE;
     if (*s == '-' && s[1] == '>' && (s[2] == '[' || s[2] == '{'))
@@ -2658,6 +2764,8 @@ S_intuit_method(pTHX_ char *start, GV *gv, CV *cv)
     int soff;
 #endif
 
     int soff;
 #endif
 
+    PERL_ARGS_ASSERT_INTUIT_METHOD;
+
     if (gv) {
        if (SvTYPE(gv) == SVt_PVGV && GvIO(gv))
            return 0;
     if (gv) {
        if (SvTYPE(gv) == SVt_PVGV && GvIO(gv))
            return 0;
@@ -2718,7 +2826,7 @@ S_intuit_method(pTHX_ char *start, GV *gv, CV *cv)
       bare_package:
            start_force(PL_curforce);
            NEXTVAL_NEXTTOKE.opval = (OP*)newSVOP(OP_CONST, 0,
       bare_package:
            start_force(PL_curforce);
            NEXTVAL_NEXTTOKE.opval = (OP*)newSVOP(OP_CONST, 0,
-                                                  newSVpvn(tmpbuf,len));
+                                                 S_newSV_maybe_utf8(aTHX_ tmpbuf, len));
            NEXTVAL_NEXTTOKE.opval->op_private = OPpCONST_BARE;
            if (PL_madskills)
                curmad('X', newSVpvn(start,SvPVX(PL_linestr) + soff - start));
            NEXTVAL_NEXTTOKE.opval->op_private = OPpCONST_BARE;
            if (PL_madskills)
                curmad('X', newSVpvn(start,SvPVX(PL_linestr) + soff - start));
@@ -2734,29 +2842,6 @@ S_intuit_method(pTHX_ char *start, GV *gv, CV *cv)
     return 0;
 }
 
     return 0;
 }
 
-/*
- * S_incl_perldb
- * Return a string of Perl code to load the debugger.  If PERL5DB
- * is set, it will return the contents of that, otherwise a
- * compile-time require of perl5db.pl.
- */
-
-STATIC const char*
-S_incl_perldb(pTHX)
-{
-    dVAR;
-    if (PL_perldb) {
-       const char * const pdb = PerlEnv_getenv("PERL5DB");
-
-       if (pdb)
-           return pdb;
-       SETERRNO(0,SS_NORMAL);
-       return "BEGIN { require 'perl5db.pl' }";
-    }
-    return "";
-}
-
-
 /* Encoded script support. filter_add() effectively inserts a
  * 'pre-processing' function into the current source input stream.
  * Note that the filter function only applies to the current source file
 /* Encoded script support. filter_add() effectively inserts a
  * 'pre-processing' function into the current source input stream.
  * Note that the filter function only applies to the current source file
@@ -2807,6 +2892,8 @@ Perl_filter_del(pTHX_ filter_t funcp)
     dVAR;
     SV *datasv;
 
     dVAR;
     SV *datasv;
 
+    PERL_ARGS_ASSERT_FILTER_DEL;
+
 #ifdef DEBUGGING
     DEBUG_P(PerlIO_printf(Perl_debug_log, "filter_del func %p",
                          FPTR2DPTR(void*, funcp)));
 #ifdef DEBUGGING
     DEBUG_P(PerlIO_printf(Perl_debug_log, "filter_del func %p",
                          FPTR2DPTR(void*, funcp)));
@@ -2847,6 +2934,8 @@ Perl_filter_read(pTHX_ int idx, SV *buf_sv, int maxlen)
 #endif
        : maxlen;
 
 #endif
        : maxlen;
 
+    PERL_ARGS_ASSERT_FILTER_READ;
+
     if (!PL_parser || !PL_rsfp_filters)
        return -1;
     if (idx > AvFILLp(PL_rsfp_filters)) {       /* Any more filters?   */
     if (!PL_parser || !PL_rsfp_filters)
        return -1;
     if (idx > AvFILLp(PL_rsfp_filters)) {       /* Any more filters?   */
@@ -2902,6 +2991,9 @@ STATIC char *
 S_filter_gets(pTHX_ register SV *sv, register PerlIO *fp, STRLEN append)
 {
     dVAR;
 S_filter_gets(pTHX_ register SV *sv, register PerlIO *fp, STRLEN append)
 {
     dVAR;
+
+    PERL_ARGS_ASSERT_FILTER_GETS;
+
 #ifdef PERL_CR_FILTER
     if (!PL_rsfp_filters) {
        filter_add(S_cr_textfilter,NULL);
 #ifdef PERL_CR_FILTER
     if (!PL_rsfp_filters) {
        filter_add(S_cr_textfilter,NULL);
@@ -2920,11 +3012,13 @@ S_filter_gets(pTHX_ register SV *sv, register PerlIO *fp, STRLEN append)
 }
 
 STATIC HV *
 }
 
 STATIC HV *
-S_find_in_my_stash(pTHX_ const char *pkgname, I32 len)
+S_find_in_my_stash(pTHX_ const char *pkgname, STRLEN len)
 {
     dVAR;
     GV *gv;
 
 {
     dVAR;
     GV *gv;
 
+    PERL_ARGS_ASSERT_FIND_IN_MY_STASH;
+
     if (len == 11 && *pkgname == '_' && strEQ(pkgname, "__PACKAGE__"))
         return PL_curstash;
 
     if (len == 11 && *pkgname == '_' && strEQ(pkgname, "__PACKAGE__"))
         return PL_curstash;
 
@@ -2940,10 +3034,10 @@ S_find_in_my_stash(pTHX_ const char *pkgname, I32 len)
     if (gv && GvCV(gv)) {
        SV * const sv = cv_const_sv(GvCV(gv));
        if (sv)
     if (gv && GvCV(gv)) {
        SV * const sv = cv_const_sv(GvCV(gv));
        if (sv)
-            pkgname = SvPV_nolen_const(sv);
+            pkgname = SvPV_const(sv, len);
     }
 
     }
 
-    return gv_stashpv(pkgname, 0);
+    return gv_stashpvn(pkgname, len, 0);
 }
 
 /*
 }
 
 /*
@@ -2956,7 +3050,7 @@ S_readpipe_override(pTHX)
 {
     GV **gvp;
     GV *gv_readpipe = gv_fetchpvs("readpipe", GV_NOTQUAL, SVt_PVCV);
 {
     GV **gvp;
     GV *gv_readpipe = gv_fetchpvs("readpipe", GV_NOTQUAL, SVt_PVCV);
-    yylval.ival = OP_BACKTICK;
+    pl_yylval.ival = OP_BACKTICK;
     if ((gv_readpipe
                && GvCVu(gv_readpipe) && GvIMPORTED_CV(gv_readpipe))
            ||
     if ((gv_readpipe
                && GvCVu(gv_readpipe) && GvIMPORTED_CV(gv_readpipe))
            ||
@@ -2969,9 +3063,6 @@ S_readpipe_override(pTHX)
                newSVOP(OP_CONST, 0, &PL_sv_undef), /* value will be read later */
                newCVREF(0, newGVOP(OP_GV, 0, gv_readpipe))));
     }
                newSVOP(OP_CONST, 0, &PL_sv_undef), /* value will be read later */
                newCVREF(0, newGVOP(OP_GV, 0, gv_readpipe))));
     }
-    else {
-       set_csh();
-    }
 }
 
 #ifdef PERL_MAD 
 }
 
 #ifdef PERL_MAD 
@@ -3082,8 +3173,8 @@ Perl_madlex(pTHX)
     case FUNC0SUB:
     case UNIOPSUB:
     case LSTOPSUB:
     case FUNC0SUB:
     case UNIOPSUB:
     case LSTOPSUB:
-       if (yylval.opval)
-           append_madprops(PL_thismad, yylval.opval, 0);
+       if (pl_yylval.opval)
+           append_madprops(PL_thismad, pl_yylval.opval, 0);
        PL_thismad = 0;
        return optype;
 
        PL_thismad = 0;
        return optype;
 
@@ -3153,7 +3244,7 @@ Perl_madlex(pTHX)
     }
 
     /* Create new token struct.  Note: opvals return early above. */
     }
 
     /* Create new token struct.  Note: opvals return early above. */
-    yylval.tkval = newTOKEN(optype, yylval, PL_thismad);
+    pl_yylval.tkval = newTOKEN(optype, pl_yylval, PL_thismad);
     PL_thismad = 0;
     return optype;
 }
     PL_thismad = 0;
     return optype;
 }
@@ -3162,6 +3253,9 @@ Perl_madlex(pTHX)
 STATIC char *
 S_tokenize_use(pTHX_ int is_use, char *s) {
     dVAR;
 STATIC char *
 S_tokenize_use(pTHX_ int is_use, char *s) {
     dVAR;
+
+    PERL_ARGS_ASSERT_TOKENIZE_USE;
+
     if (PL_expect != XSTATE)
        yyerror(Perl_form(aTHX_ "\"%s\" not allowed in expression",
                    is_use ? "use" : "no"));
     if (PL_expect != XSTATE)
        yyerror(Perl_form(aTHX_ "\"%s\" not allowed in expression",
                    is_use ? "use" : "no"));
@@ -3182,7 +3276,7 @@ S_tokenize_use(pTHX_ int is_use, char *s) {
        s = force_word(s,WORD,FALSE,TRUE,FALSE);
        s = force_version(s, FALSE);
     }
        s = force_word(s,WORD,FALSE,TRUE,FALSE);
        s = force_version(s, FALSE);
     }
-    yylval.ival = is_use;
+    pl_yylval.ival = is_use;
     return s;
 }
 #ifdef DEBUGGING
     return s;
 }
 #ifdef DEBUGGING
@@ -3263,12 +3357,12 @@ Perl_yylex(pTHX)
     case LEX_KNOWNEXT:
 #ifdef PERL_MAD
        PL_lasttoke--;
     case LEX_KNOWNEXT:
 #ifdef PERL_MAD
        PL_lasttoke--;
-       yylval = PL_nexttoke[PL_lasttoke].next_val;
+       pl_yylval = PL_nexttoke[PL_lasttoke].next_val;
        if (PL_madskills) {
            PL_thismad = PL_nexttoke[PL_lasttoke].next_mad;
            PL_nexttoke[PL_lasttoke].next_mad = 0;
            if (PL_thismad && PL_thismad->mad_key == '_') {
        if (PL_madskills) {
            PL_thismad = PL_nexttoke[PL_lasttoke].next_mad;
            PL_nexttoke[PL_lasttoke].next_mad = 0;
            if (PL_thismad && PL_thismad->mad_key == '_') {
-               PL_thiswhite = (SV*)PL_thismad->mad_val;
+               PL_thiswhite = MUTABLE_SV(PL_thismad->mad_val);
                PL_thismad->mad_val = 0;
                mad_free(PL_thismad);
                PL_thismad = 0;
                PL_thismad->mad_val = 0;
                mad_free(PL_thismad);
                PL_thismad = 0;
@@ -3283,7 +3377,7 @@ Perl_yylex(pTHX)
        }
 #else
        PL_nexttoke--;
        }
 #else
        PL_nexttoke--;
-       yylval = PL_nextval[PL_nexttoke];
+       pl_yylval = PL_nextval[PL_nexttoke];
        if (!PL_nexttoke) {
            PL_lex_state = PL_lex_defer;
            PL_expect = PL_lex_expect;
        if (!PL_nexttoke) {
            PL_lex_state = PL_lex_defer;
            PL_expect = PL_lex_expect;
@@ -3384,8 +3478,10 @@ Perl_yylex(pTHX)
                else
                    Perl_croak(aTHX_ "panic: yylex");
                if (PL_madskills) {
                else
                    Perl_croak(aTHX_ "panic: yylex");
                if (PL_madskills) {
-                   SV* const tmpsv = newSVpvs("");
-                   Perl_sv_catpvf(aTHX_ tmpsv, "\\%c", *s);
+                   SV* const tmpsv = newSVpvs("\\ ");
+                   /* replace the space with the character we want to escape
+                    */
+                   SvPVX(tmpsv)[1] = *s;
                    curmad('_', tmpsv);
                }
                PL_bufptr = s + 1;
                    curmad('_', tmpsv);
                }
                PL_bufptr = s + 1;
@@ -3496,8 +3592,8 @@ Perl_yylex(pTHX)
            if (!PL_lex_inpat)
                sv = tokeq(sv);
            else if ( PL_hints & HINT_NEW_RE )
            if (!PL_lex_inpat)
                sv = tokeq(sv);
            else if ( PL_hints & HINT_NEW_RE )
-               sv = new_constant(NULL, 0, "qr", sv, sv, "q");
-           yylval.opval = (OP*)newSVOP(OP_CONST, 0, sv);
+               sv = new_constant(NULL, 0, "qr", sv, sv, "q", 1);
+           pl_yylval.opval = (OP*)newSVOP(OP_CONST, 0, sv);
            s = PL_bufend;
        }
        else {
            s = PL_bufend;
        }
        else {
@@ -3513,7 +3609,7 @@ Perl_yylex(pTHX)
            if (PL_madskills) {
                curmad('X', newSVpvn(PL_bufptr,s-PL_bufptr));
            }
            if (PL_madskills) {
                curmad('X', newSVpvn(PL_bufptr,s-PL_bufptr));
            }
-           NEXTVAL_NEXTTOKE = yylval;
+           NEXTVAL_NEXTTOKE = pl_yylval;
            PL_expect = XTERM;
            force_next(THING);
            if (PL_lex_starts++) {
            PL_expect = XTERM;
            force_next(THING);
            if (PL_lex_starts++) {
@@ -3561,7 +3657,17 @@ Perl_yylex(pTHX)
     default:
        if (isIDFIRST_lazy_if(s,UTF))
            goto keylookup;
     default:
        if (isIDFIRST_lazy_if(s,UTF))
            goto keylookup;
-       Perl_croak(aTHX_ "Unrecognized character \\x%02X", *s & 255);
+       {
+        unsigned char c = *s;
+        len = UTF ? Perl_utf8_length(aTHX_ (U8 *) PL_linestart, (U8 *) s) : (STRLEN) (s - PL_linestart);
+        if (len > UNRECOGNIZED_PRECEDE_COUNT) {
+            d = UTF ? (char *) Perl_utf8_hop(aTHX_ (U8 *) s, -UNRECOGNIZED_PRECEDE_COUNT) : s - UNRECOGNIZED_PRECEDE_COUNT;
+        } else {
+            d = PL_linestart;
+        }      
+        *s = '\0';
+        Perl_croak(aTHX_ "Unrecognized character \\x%02X; marked by <-- HERE after %s<-- HERE near column %d", c, d, (int) len + 1);
+    }
     case 4:
     case 26:
        goto fake_eof;                  /* emulate EOF on ^D or ^Z */
     case 4:
     case 26:
        goto fake_eof;                  /* emulate EOF on ^D or ^Z */
@@ -3594,19 +3700,36 @@ Perl_yylex(pTHX)
            if (PL_madskills)
                PL_faketokens = 1;
 #endif
            if (PL_madskills)
                PL_faketokens = 1;
 #endif
-           sv_setpv(PL_linestr,incl_perldb());
-           if (SvCUR(PL_linestr))
-               sv_catpvs(PL_linestr,";");
-           if (PL_preambleav){
-               while(AvFILLp(PL_preambleav) >= 0) {
-                   SV *tmpsv = av_shift(PL_preambleav);
-                   sv_catsv(PL_linestr, tmpsv);
+           if (PL_perldb) {
+               /* Generate a string of Perl code to load the debugger.
+                * If PERL5DB is set, it will return the contents of that,
+                * otherwise a compile-time require of perl5db.pl.  */
+
+               const char * const pdb = PerlEnv_getenv("PERL5DB");
+
+               if (pdb) {
+                   sv_setpv(PL_linestr, pdb);
+                   sv_catpvs(PL_linestr,";");
+               } else {
+                   SETERRNO(0,SS_NORMAL);
+                   sv_setpvs(PL_linestr, "BEGIN { require 'perl5db.pl' };");
+               }
+           } else
+               sv_setpvs(PL_linestr,"");
+           if (PL_preambleav) {
+               SV **svp = AvARRAY(PL_preambleav);
+               SV **const end = svp + AvFILLp(PL_preambleav);
+               while(svp <= end) {
+                   sv_catsv(PL_linestr, *svp);
+                   ++svp;
                    sv_catpvs(PL_linestr, ";");
                    sv_catpvs(PL_linestr, ";");
-                   sv_free(tmpsv);
                }
                }
-               sv_free((SV*)PL_preambleav);
+               sv_free(MUTABLE_SV(PL_preambleav));
                PL_preambleav = NULL;
            }
                PL_preambleav = NULL;
            }
+           if (PL_minus_E)
+               sv_catpvs(PL_linestr,
+                         "use feature ':5." STRINGIFY(PERL_VERSION) "';");
            if (PL_minus_n || PL_minus_p) {
                sv_catpvs(PL_linestr, "LINE: while (<>) {");
                if (PL_minus_l)
            if (PL_minus_n || PL_minus_p) {
                sv_catpvs(PL_linestr, "LINE: while (<>) {");
                if (PL_minus_l)
@@ -3638,13 +3761,11 @@ Perl_yylex(pTHX)
                        sv_catpvs(PL_linestr,"our @F=split(' ');");
                }
            }
                        sv_catpvs(PL_linestr,"our @F=split(' ');");
                }
            }
-           if (PL_minus_E)
-               sv_catpvs(PL_linestr,"use feature ':5.10';");
            sv_catpvs(PL_linestr, "\n");
            PL_oldoldbufptr = PL_oldbufptr = s = PL_linestart = SvPVX(PL_linestr);
            PL_bufend = SvPVX(PL_linestr) + SvCUR(PL_linestr);
            PL_last_lop = PL_last_uni = NULL;
            sv_catpvs(PL_linestr, "\n");
            PL_oldoldbufptr = PL_oldbufptr = s = PL_linestart = SvPVX(PL_linestr);
            PL_bufend = SvPVX(PL_linestr) + SvCUR(PL_linestr);
            PL_last_lop = PL_last_uni = NULL;
-           if (PERLDB_LINE && PL_curstash != PL_debstash)
+           if ((PERLDB_LINE || PERLDB_SAVESRC) && PL_curstash != PL_debstash)
                update_debugger_info(PL_linestr, NULL, 0);
            goto retry;
        }
                update_debugger_info(PL_linestr, NULL, 0);
            goto retry;
        }
@@ -3656,9 +3777,7 @@ Perl_yylex(pTHX)
                PL_realtokenstart = -1;
 #endif
                if (PL_rsfp) {
                PL_realtokenstart = -1;
 #endif
                if (PL_rsfp) {
-                   if (PL_preprocess && !PL_in_eval)
-                       (void)PerlProc_pclose(PL_rsfp);
-                   else if ((PerlIO *)PL_rsfp == PerlIO_stdin())
+                   if ((PerlIO *)PL_rsfp == PerlIO_stdin())
                        PerlIO_clearerr(PL_rsfp);
                    else
                        (void)PerlIO_close(PL_rsfp);
                        PerlIO_clearerr(PL_rsfp);
                    else
                        (void)PerlIO_close(PL_rsfp);
@@ -3670,10 +3789,10 @@ Perl_yylex(pTHX)
                    if (PL_madskills)
                        PL_faketokens = 1;
 #endif
                    if (PL_madskills)
                        PL_faketokens = 1;
 #endif
-                   sv_setpv(PL_linestr,
-                            (const char *)
-                            (PL_minus_p
-                             ? ";}continue{print;}" : ";}"));
+                   if (PL_minus_p)
+                       sv_setpvs(PL_linestr, ";}continue{print;}");
+                   else
+                       sv_setpvs(PL_linestr, ";}");
                    PL_oldoldbufptr = PL_oldbufptr = s = PL_linestart = SvPVX(PL_linestr);
                    PL_bufend = SvPVX(PL_linestr) + SvCUR(PL_linestr);
                    PL_last_lop = PL_last_uni = NULL;
                    PL_oldoldbufptr = PL_oldbufptr = s = PL_linestart = SvPVX(PL_linestr);
                    PL_bufend = SvPVX(PL_linestr) + SvCUR(PL_linestr);
                    PL_last_lop = PL_last_uni = NULL;
@@ -3682,7 +3801,7 @@ Perl_yylex(pTHX)
                }
                PL_oldoldbufptr = PL_oldbufptr = s = PL_linestart = SvPVX(PL_linestr);
                PL_last_lop = PL_last_uni = NULL;
                }
                PL_oldoldbufptr = PL_oldbufptr = s = PL_linestart = SvPVX(PL_linestr);
                PL_last_lop = PL_last_uni = NULL;
-               sv_setpvn(PL_linestr,"",0);
+               sv_setpvs(PL_linestr,"");
                TOKEN(';');     /* not infinite loop because rsfp is NULL now */
            }
            /* If it looks like the start of a BOM or raw UTF-16,
                TOKEN(';');     /* not infinite loop because rsfp is NULL now */
            }
            /* If it looks like the start of a BOM or raw UTF-16,
@@ -3705,16 +3824,7 @@ Perl_yylex(pTHX)
 #    endif
 #  endif
 #endif
 #    endif
 #  endif
 #endif
-#ifdef FTELL_FOR_PIPE_IS_BROKEN
-               /* This loses the possibility to detect the bof
-                * situation on perl -P when the libc5 is being used.
-                * Workaround?  Maybe attach some extra state to PL_rsfp?
-                */
-               if (!PL_preprocess)
-                   bof = PerlIO_tell(PL_rsfp) == SvCUR(PL_linestr);
-#else
                bof = PerlIO_tell(PL_rsfp) == (Off_t)SvCUR(PL_linestr);
                bof = PerlIO_tell(PL_rsfp) == (Off_t)SvCUR(PL_linestr);
-#endif
                if (bof) {
                    PL_bufend = SvPVX(PL_linestr) + SvCUR(PL_linestr);
                    s = swallow_bom((U8*)s);
                if (bof) {
                    PL_bufend = SvPVX(PL_linestr) + SvCUR(PL_linestr);
                    s = swallow_bom((U8*)s);
@@ -3727,7 +3837,7 @@ Perl_yylex(pTHX)
                    sv_catsv(PL_thiswhite, PL_linestr);
 #endif
                if (*s == '=' && strnEQ(s, "=cut", 4) && !isALPHA(s[4])) {
                    sv_catsv(PL_thiswhite, PL_linestr);
 #endif
                if (*s == '=' && strnEQ(s, "=cut", 4) && !isALPHA(s[4])) {
-                   sv_setpvn(PL_linestr, "", 0);
+                   sv_setpvs(PL_linestr, "");
                    PL_oldoldbufptr = PL_oldbufptr = s = PL_linestart = SvPVX(PL_linestr);
                    PL_bufend = SvPVX(PL_linestr) + SvCUR(PL_linestr);
                    PL_last_lop = PL_last_uni = NULL;
                    PL_oldoldbufptr = PL_oldbufptr = s = PL_linestart = SvPVX(PL_linestr);
                    PL_bufend = SvPVX(PL_linestr) + SvCUR(PL_linestr);
                    PL_last_lop = PL_last_uni = NULL;
@@ -3737,7 +3847,7 @@ Perl_yylex(pTHX)
            incline(s);
        } while (PL_doextract);
        PL_oldoldbufptr = PL_oldbufptr = PL_bufptr = PL_linestart = s;
            incline(s);
        } while (PL_doextract);
        PL_oldoldbufptr = PL_oldbufptr = PL_bufptr = PL_linestart = s;
-       if (PERLDB_LINE && PL_curstash != PL_debstash)
+       if ((PERLDB_LINE || PERLDB_SAVESRC) && PL_curstash != PL_debstash)
            update_debugger_info(PL_linestr, NULL, 0);
        PL_bufend = SvPVX(PL_linestr) + SvCUR(PL_linestr);
        PL_last_lop = PL_last_uni = NULL;
            update_debugger_info(PL_linestr, NULL, 0);
        PL_bufend = SvPVX(PL_linestr) + SvCUR(PL_linestr);
        PL_last_lop = PL_last_uni = NULL;
@@ -3847,7 +3957,6 @@ Perl_yylex(pTHX)
                        *s = '#';       /* Don't try to parse shebang line */
                }
 #endif /* ALTERNATE_SHEBANG */
                        *s = '#';       /* Don't try to parse shebang line */
                }
 #endif /* ALTERNATE_SHEBANG */
-#ifndef MACOS_TRADITIONAL
                if (!d &&
                    *s == '#' &&
                    ipathend > ipath &&
                if (!d &&
                    *s == '#' &&
                    ipathend > ipath &&
@@ -3863,7 +3972,7 @@ Perl_yylex(pTHX)
                    while (s < PL_bufend && isSPACE(*s))
                        s++;
                    if (s < PL_bufend) {
                    while (s < PL_bufend && isSPACE(*s))
                        s++;
                    if (s < PL_bufend) {
-                       Newxz(newargv,PL_origargc+3,char*);
+                       Newx(newargv,PL_origargc+3,char*);
                        newargv[1] = s;
                        while (s < PL_bufend && !isSPACE(*s))
                            s++;
                        newargv[1] = s;
                        while (s < PL_bufend && !isSPACE(*s))
                            s++;
@@ -3878,7 +3987,6 @@ Perl_yylex(pTHX)
                    PERL_FPU_POST_EXEC
                    Perl_croak(aTHX_ "Can't exec %s", ipath);
                }
                    PERL_FPU_POST_EXEC
                    Perl_croak(aTHX_ "Can't exec %s", ipath);
                }
-#endif
                if (d) {
                    while (*d && !isSPACE(*d))
                        d++;
                if (d) {
                    while (*d && !isSPACE(*d))
                        d++;
@@ -3890,17 +3998,25 @@ Perl_yylex(pTHX)
                        const U32 oldpdb = PL_perldb;
                        const bool oldn = PL_minus_n;
                        const bool oldp = PL_minus_p;
                        const U32 oldpdb = PL_perldb;
                        const bool oldn = PL_minus_n;
                        const bool oldp = PL_minus_p;
+                       const char *d1 = d;
 
                        do {
 
                        do {
-                           if (*d == 'M' || *d == 'm' || *d == 'C') {
-                               const char * const m = d;
-                               while (*d && !isSPACE(*d))
-                                   d++;
+                           bool baduni = FALSE;
+                           if (*d1 == 'C') {
+                               const char *d2 = d1 + 1;
+                               if (parse_unicode_opts((const char **)&d2)
+                                   != PL_unicode)
+                                   baduni = TRUE;
+                           }
+                           if (baduni || *d1 == 'M' || *d1 == 'm') {
+                               const char * const m = d1;
+                               while (*d1 && !isSPACE(*d1))
+                                   d1++;
                                Perl_croak(aTHX_ "Too late for \"-%.*s\" option",
                                Perl_croak(aTHX_ "Too late for \"-%.*s\" option",
-                                     (int)(d - m), m);
+                                     (int)(d1 - m), m);
                            }
                            }
-                           d = moreswitches(d);
-                       } while (d);
+                           d1 = moreswitches(d1);
+                       } while (d1);
                        if (PL_doswitches && !switches_done) {
                            int argc = PL_origargc;
                            char **argv = PL_origargv;
                        if (PL_doswitches && !switches_done) {
                            int argc = PL_origargc;
                            char **argv = PL_origargv;
@@ -3909,17 +4025,17 @@ Perl_yylex(pTHX)
                            } while (argc && argv[0][0] == '-' && argv[0][1]);
                            init_argv_symbols(argc,argv);
                        }
                            } while (argc && argv[0][0] == '-' && argv[0][1]);
                            init_argv_symbols(argc,argv);
                        }
-                       if ((PERLDB_LINE && !oldpdb) ||
+                       if (((PERLDB_LINE || PERLDB_SAVESRC) && !oldpdb) ||
                            ((PL_minus_n || PL_minus_p) && !(oldn || oldp)))
                              /* if we have already added "LINE: while (<>) {",
                                 we must not do it again */
                        {
                            ((PL_minus_n || PL_minus_p) && !(oldn || oldp)))
                              /* if we have already added "LINE: while (<>) {",
                                 we must not do it again */
                        {
-                           sv_setpvn(PL_linestr, "", 0);
+                           sv_setpvs(PL_linestr, "");
                            PL_oldoldbufptr = PL_oldbufptr = s = PL_linestart = SvPVX(PL_linestr);
                            PL_bufend = SvPVX(PL_linestr) + SvCUR(PL_linestr);
                            PL_last_lop = PL_last_uni = NULL;
                            PL_preambled = FALSE;
                            PL_oldoldbufptr = PL_oldbufptr = s = PL_linestart = SvPVX(PL_linestr);
                            PL_bufend = SvPVX(PL_linestr) + SvCUR(PL_linestr);
                            PL_last_lop = PL_last_uni = NULL;
                            PL_preambled = FALSE;
-                           if (PERLDB_LINE)
+                           if (PERLDB_LINE || PERLDB_SAVESRC)
                                (void)gv_fetchfile(PL_origfilename);
                            goto retry;
                        }
                                (void)gv_fetchfile(PL_origfilename);
                            goto retry;
                        }
@@ -3940,9 +4056,6 @@ Perl_yylex(pTHX)
       "\t(Maybe you didn't strip carriage returns after a network transfer?)\n");
 #endif
     case ' ': case '\t': case '\f': case 013:
       "\t(Maybe you didn't strip carriage returns after a network transfer?)\n");
 #endif
     case ' ': case '\t': case '\f': case 013:
-#ifdef MACOS_TRADITIONAL
-    case '\312':
-#endif
 #ifdef PERL_MAD
        PL_realtokenstart = -1;
        if (!PL_thiswhite)
 #ifdef PERL_MAD
        PL_realtokenstart = -1;
        if (!PL_thiswhite)
@@ -4013,7 +4126,7 @@ Perl_yylex(pTHX)
                        if (!PL_thiswhite)
                            PL_thiswhite = newSVpvs("");
                        if (CopLINE(PL_curcop) == 1) {
                        if (!PL_thiswhite)
                            PL_thiswhite = newSVpvs("");
                        if (CopLINE(PL_curcop) == 1) {
-                           sv_setpvn(PL_thiswhite, "", 0);
+                           sv_setpvs(PL_thiswhite, "");
                            PL_faketokens = 0;
                        }
                        sv_catpvn(PL_thiswhite, s, d - s);
                            PL_faketokens = 0;
                        }
                        sv_catpvn(PL_thiswhite, s, d - s);
@@ -4185,7 +4298,10 @@ Perl_yylex(pTHX)
        BOop(OP_BIT_XOR);
     case '[':
        PL_lex_brackets++;
        BOop(OP_BIT_XOR);
     case '[':
        PL_lex_brackets++;
-       /* FALL THROUGH */
+       {
+           const char tmp = *s++;
+           OPERATOR(tmp);
+       }
     case '~':
        if (s[1] == '~'
            && (PL_expect == XOPERATOR || PL_expect == XTERMORDORDOR))
     case '~':
        if (s[1] == '~'
            && (PL_expect == XOPERATOR || PL_expect == XTERMORDORDOR))
@@ -4234,8 +4350,8 @@ Perl_yylex(pTHX)
                    switch (tmp) {
                    case KEY_or:
                    case KEY_and:
                    switch (tmp) {
                    case KEY_or:
                    case KEY_and:
-                   case KEY_err:
                    case KEY_for:
                    case KEY_for:
+                   case KEY_foreach:
                    case KEY_unless:
                    case KEY_if:
                    case KEY_while:
                    case KEY_unless:
                    case KEY_if:
                    case KEY_while:
@@ -4271,11 +4387,6 @@ Perl_yylex(pTHX)
                    if (len == 6 && strnEQ(SvPVX(sv), "unique", len)) {
                        sv_free(sv);
                        if (PL_in_my == KEY_our) {
                    if (len == 6 && strnEQ(SvPVX(sv), "unique", len)) {
                        sv_free(sv);
                        if (PL_in_my == KEY_our) {
-#ifdef USE_ITHREADS
-                           GvUNIQUE_on(cGVOPx_gv(yylval.opval));
-#else
-                           /* skip to avoid loading attributes.pm */
-#endif
                            deprecate(":unique");
                        }
                        else
                            deprecate(":unique");
                        }
                        else
@@ -4290,7 +4401,7 @@ Perl_yylex(pTHX)
                    }
                    else if (!PL_in_my && len == 6 && strnEQ(SvPVX(sv), "locked", len)) {
                        sv_free(sv);
                    }
                    else if (!PL_in_my && len == 6 && strnEQ(SvPVX(sv), "locked", len)) {
                        sv_free(sv);
-                       CvLOCKED_on(PL_compcv);
+                       deprecate(":locked");
                    }
                    else if (!PL_in_my && len == 6 && strnEQ(SvPVX(sv), "method", len)) {
                        sv_free(sv);
                    }
                    else if (!PL_in_my && len == 6 && strnEQ(SvPVX(sv), "method", len)) {
                        sv_free(sv);
@@ -4555,7 +4666,7 @@ Perl_yylex(pTHX)
            }
            break;
        }
            }
            break;
        }
-       yylval.ival = CopLINE(PL_curcop);
+       pl_yylval.ival = CopLINE(PL_curcop);
        if (isSPACE(*s) || *s == '#')
            PL_copline = NOLINE;   /* invalidate current command line number */
        TOKEN('{');
        if (isSPACE(*s) || *s == '#')
            PL_copline = NOLINE;   /* invalidate current command line number */
        TOKEN('{');
@@ -4578,7 +4689,7 @@ Perl_yylex(pTHX)
                    if (PL_madskills) {
                        if (!PL_thiswhite)
                            PL_thiswhite = newSVpvs("");
                    if (PL_madskills) {
                        if (!PL_thiswhite)
                            PL_thiswhite = newSVpvs("");
-                       sv_catpvn(PL_thiswhite,"}",1);
+                       sv_catpvs(PL_thiswhite,"}");
                    }
 #endif
                    return yylex();     /* ignore fake brackets */
                    }
 #endif
                    return yylex();     /* ignore fake brackets */
@@ -4615,7 +4726,7 @@ Perl_yylex(pTHX)
                && isIDFIRST_lazy_if(s,UTF))
            {
                CopLINE_dec(PL_curcop);
                && isIDFIRST_lazy_if(s,UTF))
            {
                CopLINE_dec(PL_curcop);
-               Perl_warner(aTHX_ packWARN(WARN_SEMICOLON), PL_warn_nosemi);
+               Perl_warner(aTHX_ packWARN(WARN_SEMICOLON), "%s", PL_warn_nosemi);
                CopLINE_inc(PL_curcop);
            }
            BAop(OP_BIT_AND);
                CopLINE_inc(PL_curcop);
            }
            BAop(OP_BIT_AND);
@@ -4628,7 +4739,7 @@ Perl_yylex(pTHX)
        }
        else
            PREREF('&');
        }
        else
            PREREF('&');
-       yylval.ival = (OPpENTERSUB_AMPER<<8);
+       pl_yylval.ival = (OPpENTERSUB_AMPER<<8);
        TERM('&');
 
     case '|':
        TERM('&');
 
     case '|':
@@ -4700,7 +4811,7 @@ Perl_yylex(pTHX)
                goto leftbracket;
            }
        }
                goto leftbracket;
            }
        }
-       yylval.ival = 0;
+       pl_yylval.ival = 0;
        OPERATOR(ASSIGNOP);
     case '!':
        s++;
        OPERATOR(ASSIGNOP);
     case '!':
        s++;
@@ -4804,9 +4915,9 @@ Perl_yylex(pTHX)
 
        /* This kludge not intended to be bulletproof. */
        if (PL_tokenbuf[1] == '[' && !PL_tokenbuf[2]) {
 
        /* This kludge not intended to be bulletproof. */
        if (PL_tokenbuf[1] == '[' && !PL_tokenbuf[2]) {
-           yylval.opval = newSVOP(OP_CONST, 0,
+           pl_yylval.opval = newSVOP(OP_CONST, 0,
                                   newSViv(CopARYBASE_get(&PL_compiling)));
                                   newSViv(CopARYBASE_get(&PL_compiling)));
-           yylval.opval->op_private = OPpCONST_ARYBASE;
+           pl_yylval.opval->op_private = OPpCONST_ARYBASE;
            TERM(THING);
        }
 
            TERM(THING);
        }
 
@@ -4954,10 +5065,10 @@ Perl_yylex(pTHX)
            AOPERATOR(DORDOR);
        }
      case '?':                 /* may either be conditional or pattern */
            AOPERATOR(DORDOR);
        }
      case '?':                 /* may either be conditional or pattern */
-        if(PL_expect == XOPERATOR) {
+       if (PL_expect == XOPERATOR) {
             char tmp = *s++;
             if(tmp == '?') {
             char tmp = *s++;
             if(tmp == '?') {
-                 OPERATOR('?');
+               OPERATOR('?');
             }
              else {
                 tmp = *s++;
             }
              else {
                 tmp = *s++;
@@ -4996,16 +5107,20 @@ Perl_yylex(pTHX)
            PL_expect = XSTATE;
            goto rightbracket;
        }
            PL_expect = XSTATE;
            goto rightbracket;
        }
+       if (PL_expect == XSTATE && s[1] == '.' && s[2] == '.') {
+           s += 3;
+           OPERATOR(YADAYADA);
+       }
        if (PL_expect == XOPERATOR || !isDIGIT(s[1])) {
            char tmp = *s++;
            if (*s == tmp) {
                s++;
                if (*s == tmp) {
                    s++;
        if (PL_expect == XOPERATOR || !isDIGIT(s[1])) {
            char tmp = *s++;
            if (*s == tmp) {
                s++;
                if (*s == tmp) {
                    s++;
-                   yylval.ival = OPf_SPECIAL;
+                   pl_yylval.ival = OPf_SPECIAL;
                }
                else
                }
                else
-                   yylval.ival = 0;
+                   pl_yylval.ival = 0;
                OPERATOR(DOTDOT);
            }
            if (PL_expect != XOPERATOR)
                OPERATOR(DOTDOT);
            }
            if (PL_expect != XOPERATOR)
@@ -5015,7 +5130,7 @@ Perl_yylex(pTHX)
        /* FALL THROUGH */
     case '0': case '1': case '2': case '3': case '4':
     case '5': case '6': case '7': case '8': case '9':
        /* FALL THROUGH */
     case '0': case '1': case '2': case '3': case '4':
     case '5': case '6': case '7': case '8': case '9':
-       s = scan_num(s, &yylval);
+       s = scan_num(s, &pl_yylval);
        DEBUG_T( { printbuf("### Saw number in %s\n", s); } );
        if (PL_expect == XOPERATOR)
            no_op("Number",s);
        DEBUG_T( { printbuf("### Saw number in %s\n", s); } );
        if (PL_expect == XOPERATOR)
            no_op("Number",s);
@@ -5035,7 +5150,7 @@ Perl_yylex(pTHX)
        }
        if (!s)
            missingterm(NULL);
        }
        if (!s)
            missingterm(NULL);
-       yylval.ival = OP_CONST;
+       pl_yylval.ival = OP_CONST;
        TERM(sublex_start());
 
     case '"':
        TERM(sublex_start());
 
     case '"':
@@ -5052,12 +5167,12 @@ Perl_yylex(pTHX)
        }
        if (!s)
            missingterm(NULL);
        }
        if (!s)
            missingterm(NULL);
-       yylval.ival = OP_CONST;
+       pl_yylval.ival = OP_CONST;
        /* FIXME. I think that this can be const if char *d is replaced by
           more localised variables.  */
        for (d = SvPV(PL_lex_stuff, len); len; len--, d++) {
            if (*d == '$' || *d == '@' || *d == '\\' || !UTF8_IS_INVARIANT((U8)*d)) {
        /* FIXME. I think that this can be const if char *d is replaced by
           more localised variables.  */
        for (d = SvPV(PL_lex_stuff, len); len; len--, d++) {
            if (*d == '$' || *d == '@' || *d == '\\' || !UTF8_IS_INVARIANT((U8)*d)) {
-               yylval.ival = OP_STRINGIFY;
+               pl_yylval.ival = OP_STRINGIFY;
                break;
            }
        }
                break;
            }
        }
@@ -5088,21 +5203,16 @@ Perl_yylex(pTHX)
            while (isDIGIT(*start) || *start == '_')
                start++;
            if (*start == '.' && isDIGIT(start[1])) {
            while (isDIGIT(*start) || *start == '_')
                start++;
            if (*start == '.' && isDIGIT(start[1])) {
-               s = scan_num(s, &yylval);
+               s = scan_num(s, &pl_yylval);
                TERM(THING);
            }
            /* avoid v123abc() or $h{v1}, allow C<print v10;> */
            else if (!isALPHA(*start) && (PL_expect == XTERM
                        || PL_expect == XREF || PL_expect == XSTATE
                        || PL_expect == XTERMORDORDOR)) {
                TERM(THING);
            }
            /* avoid v123abc() or $h{v1}, allow C<print v10;> */
            else if (!isALPHA(*start) && (PL_expect == XTERM
                        || PL_expect == XREF || PL_expect == XSTATE
                        || PL_expect == XTERMORDORDOR)) {
-               /* XXX Use gv_fetchpvn rather than stomping on a const string */
-               const char c = *start;
-               GV *gv;
-               *start = '\0';
-               gv = gv_fetchpv(s, 0, SVt_PVCV);
-               *start = c;
+               GV *const gv = gv_fetchpvn_flags(s, start - s, 0, SVt_PVCV);
                if (!gv) {
                if (!gv) {
-                   s = scan_num(s, &yylval);
+                   s = scan_num(s, &pl_yylval);
                    TERM(THING);
                }
            }
                    TERM(THING);
                }
            }
@@ -5170,22 +5280,25 @@ Perl_yylex(pTHX)
        /* Is this a label? */
        if (!tmp && PL_expect == XSTATE
              && d < PL_bufend && *d == ':' && *(d + 1) != ':') {
        /* Is this a label? */
        if (!tmp && PL_expect == XSTATE
              && d < PL_bufend && *d == ':' && *(d + 1) != ':') {
+           tmp = keyword(PL_tokenbuf, len, 0);
+           if (tmp)
+               Perl_croak(aTHX_ "Can't use keyword '%s' as a label", PL_tokenbuf);
            s = d + 1;
            s = d + 1;
-           yylval.pval = CopLABEL_alloc(PL_tokenbuf);
+           pl_yylval.pval = CopLABEL_alloc(PL_tokenbuf);
            CLINE;
            TOKEN(LABEL);
        }
            CLINE;
            TOKEN(LABEL);
        }
-
-       /* Check for keywords */
-       tmp = keyword(PL_tokenbuf, len, 0);
+       else
+           /* Check for keywords */
+           tmp = keyword(PL_tokenbuf, len, 0);
 
        /* Is this a word before a => operator? */
        if (*d == '=' && d[1] == '>') {
            CLINE;
 
        /* Is this a word before a => operator? */
        if (*d == '=' && d[1] == '>') {
            CLINE;
-           yylval.opval
+           pl_yylval.opval
                = (OP*)newSVOP(OP_CONST, 0,
                               S_newSV_maybe_utf8(aTHX_ PL_tokenbuf, len));
                = (OP*)newSVOP(OP_CONST, 0,
                               S_newSV_maybe_utf8(aTHX_ PL_tokenbuf, len));
-           yylval.opval->op_private = OPpCONST_BARE;
+           pl_yylval.opval->op_private = OPpCONST_BARE;
            TERM(WORD);
        }
 
            TERM(WORD);
        }
 
@@ -5276,7 +5389,7 @@ Perl_yylex(pTHX)
                if (PL_expect == XOPERATOR) {
                    if (PL_bufptr == PL_linestart) {
                        CopLINE_dec(PL_curcop);
                if (PL_expect == XOPERATOR) {
                    if (PL_bufptr == PL_linestart) {
                        CopLINE_dec(PL_curcop);
-                       Perl_warner(aTHX_ packWARN(WARN_SEMICOLON), PL_warn_nosemi);
+                       Perl_warner(aTHX_ packWARN(WARN_SEMICOLON), "%s", PL_warn_nosemi);
                        CopLINE_inc(PL_curcop);
                    }
                    else
                        CopLINE_inc(PL_curcop);
                    }
                    else
@@ -5327,7 +5440,7 @@ Perl_yylex(pTHX)
 #ifdef PERL_MAD
                if (PL_madskills && !PL_thistoken) {
                    char *start = SvPVX(PL_linestr) + PL_realtokenstart;
 #ifdef PERL_MAD
                if (PL_madskills && !PL_thistoken) {
                    char *start = SvPVX(PL_linestr) + PL_realtokenstart;
-                   PL_thistoken = newSVpv(start,s - start);
+                   PL_thistoken = newSVpvn(start,s - start);
                    PL_realtokenstart = s - SvPVX(PL_linestr);
                }
 #endif
                    PL_realtokenstart = s - SvPVX(PL_linestr);
                }
 #endif
@@ -5335,8 +5448,8 @@ Perl_yylex(pTHX)
                /* Presume this is going to be a bareword of some sort. */
 
                CLINE;
                /* Presume this is going to be a bareword of some sort. */
 
                CLINE;
-               yylval.opval = (OP*)newSVOP(OP_CONST, 0, sv);
-               yylval.opval->op_private = OPpCONST_BARE;
+               pl_yylval.opval = (OP*)newSVOP(OP_CONST, 0, sv);
+               pl_yylval.opval->op_private = OPpCONST_BARE;
                /* UTF-8 package name? */
                if (UTF && !IN_BYTES &&
                    is_utf8_string((U8*)SvPVX_const(sv), SvCUR(sv)))
                /* UTF-8 package name? */
                if (UTF && !IN_BYTES &&
                    is_utf8_string((U8*)SvPVX_const(sv), SvCUR(sv)))
@@ -5358,7 +5471,7 @@ Perl_yylex(pTHX)
                    /* Real typeglob, so get the real subroutine: */
                           ? GvCVu(gv)
                    /* A proxy for a subroutine in this package? */
                    /* Real typeglob, so get the real subroutine: */
                           ? GvCVu(gv)
                    /* A proxy for a subroutine in this package? */
-                          : SvOK(gv) ? (CV *) gv : NULL)
+                          : SvOK(gv) ? MUTABLE_CV(gv) : NULL)
                    : NULL;
 
                /* See if it's the indirect object for a list operator. */
                    : NULL;
 
                /* See if it's the indirect object for a list operator. */
@@ -5415,9 +5528,9 @@ Perl_yylex(pTHX)
                /* Is this a word before a => operator? */
                if (*s == '=' && s[1] == '>' && !pkgname) {
                    CLINE;
                /* Is this a word before a => operator? */
                if (*s == '=' && s[1] == '>' && !pkgname) {
                    CLINE;
-                   sv_setpv(((SVOP*)yylval.opval)->op_sv, PL_tokenbuf);
+                   sv_setpv(((SVOP*)pl_yylval.opval)->op_sv, PL_tokenbuf);
                    if (UTF && !IN_BYTES && is_utf8_string((U8*)PL_tokenbuf, len))
                    if (UTF && !IN_BYTES && is_utf8_string((U8*)PL_tokenbuf, len))
-                     SvUTF8_on(((SVOP*)yylval.opval)->op_sv);
+                     SvUTF8_on(((SVOP*)pl_yylval.opval)->op_sv);
                    TERM(WORD);
                }
 
                    TERM(WORD);
                }
 
@@ -5440,7 +5553,7 @@ Perl_yylex(pTHX)
                    }
                    start_force(PL_curforce);
 #endif
                    }
                    start_force(PL_curforce);
 #endif
-                   NEXTVAL_NEXTTOKE.opval = yylval.opval;
+                   NEXTVAL_NEXTTOKE.opval = pl_yylval.opval;
                    PL_expect = XOPERATOR;
 #ifdef PERL_MAD
                    if (PL_madskills) {
                    PL_expect = XOPERATOR;
 #ifdef PERL_MAD
                    if (PL_madskills) {
@@ -5450,7 +5563,7 @@ Perl_yylex(pTHX)
                    }
 #endif
                    force_next(WORD);
                    }
 #endif
                    force_next(WORD);
-                   yylval.ival = 0;
+                   pl_yylval.ival = 0;
                    TOKEN('&');
                }
 
                    TOKEN('&');
                }
 
@@ -5479,9 +5592,9 @@ Perl_yylex(pTHX)
                    /* Check for a constant sub */
                    if ((sv = gv_const_sv(gv))) {
                  its_constant:
                    /* Check for a constant sub */
                    if ((sv = gv_const_sv(gv))) {
                  its_constant:
-                       SvREFCNT_dec(((SVOP*)yylval.opval)->op_sv);
-                       ((SVOP*)yylval.opval)->op_sv = SvREFCNT_inc_simple(sv);
-                       yylval.opval->op_private = 0;
+                       SvREFCNT_dec(((SVOP*)pl_yylval.opval)->op_sv);
+                       ((SVOP*)pl_yylval.opval)->op_sv = SvREFCNT_inc_simple(sv);
+                       pl_yylval.opval->op_private = 0;
                        TOKEN(WORD);
                    }
 
                        TOKEN(WORD);
                    }
 
@@ -5494,9 +5607,9 @@ Perl_yylex(pTHX)
                        cv = GvCV(gv);
                    }
 
                        cv = GvCV(gv);
                    }
 
-                   op_free(yylval.opval);
-                   yylval.opval = newCVREF(0, newGVOP(OP_GV, 0, gv));
-                   yylval.opval->op_private |= OPpENTERSUB_NOPAREN;
+                   op_free(pl_yylval.opval);
+                   pl_yylval.opval = newCVREF(0, newGVOP(OP_GV, 0, gv));
+                   pl_yylval.opval->op_private |= OPpENTERSUB_NOPAREN;
                    PL_last_lop = PL_oldbufptr;
                    PL_last_lop_op = OP_ENTERSUB;
                    /* Is there a prototype? */
                    PL_last_lop = PL_oldbufptr;
                    PL_last_lop_op = OP_ENTERSUB;
                    /* Is there a prototype? */
@@ -5507,7 +5620,7 @@ Perl_yylex(pTHX)
                        SvPOK(cv))
                    {
                        STRLEN protolen;
                        SvPOK(cv))
                    {
                        STRLEN protolen;
-                       const char *proto = SvPV_const((SV*)cv, protolen);
+                       const char *proto = SvPV_const(MUTABLE_SV(cv), protolen);
                        if (!protolen)
                            TERM(FUNC0SUB);
                        if ((*proto == '$' || *proto == '_') && proto[1] == '\0')
                        if (!protolen)
                            TERM(FUNC0SUB);
                        if ((*proto == '$' || *proto == '_') && proto[1] == '\0')
@@ -5515,10 +5628,10 @@ Perl_yylex(pTHX)
                        while (*proto == ';')
                            proto++;
                        if (*proto == '&' && *s == '{') {
                        while (*proto == ';')
                            proto++;
                        if (*proto == '&' && *s == '{') {
-                           sv_setpv(PL_subname,
-                                    (const char *)
-                                    (PL_curstash ?
-                                     "__ANON__" : "__ANON__::__ANON__"));
+                           if (PL_curstash)
+                               sv_setpvs(PL_subname, "__ANON__");
+                           else
+                               sv_setpvs(PL_subname, "__ANON__::__ANON__");
                            PREBLOCK(LSTOPSUB);
                        }
                    }
                            PREBLOCK(LSTOPSUB);
                        }
                    }
@@ -5529,7 +5642,7 @@ Perl_yylex(pTHX)
                            PL_thiswhite = 0;
                        }
                        start_force(PL_curforce);
                            PL_thiswhite = 0;
                        }
                        start_force(PL_curforce);
-                       NEXTVAL_NEXTTOKE.opval = yylval.opval;
+                       NEXTVAL_NEXTTOKE.opval = pl_yylval.opval;
                        PL_expect = XTERM;
                        if (PL_madskills) {
                            PL_nextwhite = nextPL_nextwhite;
                        PL_expect = XTERM;
                        if (PL_madskills) {
                            PL_nextwhite = nextPL_nextwhite;
@@ -5562,15 +5675,15 @@ Perl_yylex(pTHX)
                    }
                    if (probable_sub) {
                        gv = gv_fetchpv(PL_tokenbuf, GV_ADD, SVt_PVCV);
                    }
                    if (probable_sub) {
                        gv = gv_fetchpv(PL_tokenbuf, GV_ADD, SVt_PVCV);
-                       op_free(yylval.opval);
-                       yylval.opval = newCVREF(0, newGVOP(OP_GV, 0, gv));
-                       yylval.opval->op_private |= OPpENTERSUB_NOPAREN;
+                       op_free(pl_yylval.opval);
+                       pl_yylval.opval = newCVREF(0, newGVOP(OP_GV, 0, gv));
+                       pl_yylval.opval->op_private |= OPpENTERSUB_NOPAREN;
                        PL_last_lop = PL_oldbufptr;
                        PL_last_lop_op = OP_ENTERSUB;
                        PL_nextwhite = PL_thiswhite;
                        PL_thiswhite = 0;
                        start_force(PL_curforce);
                        PL_last_lop = PL_oldbufptr;
                        PL_last_lop_op = OP_ENTERSUB;
                        PL_nextwhite = PL_thiswhite;
                        PL_thiswhite = 0;
                        start_force(PL_curforce);
-                       NEXTVAL_NEXTTOKE.opval = yylval.opval;
+                       NEXTVAL_NEXTTOKE.opval = pl_yylval.opval;
                        PL_expect = XTERM;
                        PL_nextwhite = nextPL_nextwhite;
                        curmad('X', PL_thistoken);
                        PL_expect = XTERM;
                        PL_nextwhite = nextPL_nextwhite;
                        curmad('X', PL_thistoken);
@@ -5579,7 +5692,7 @@ Perl_yylex(pTHX)
                        TOKEN(NOAMP);
                    }
 #else
                        TOKEN(NOAMP);
                    }
 #else
-                   NEXTVAL_NEXTTOKE.opval = yylval.opval;
+                   NEXTVAL_NEXTTOKE.opval = pl_yylval.opval;
                    PL_expect = XTERM;
                    force_next(WORD);
                    TOKEN(NOAMP);
                    PL_expect = XTERM;
                    force_next(WORD);
                    TOKEN(NOAMP);
@@ -5589,9 +5702,21 @@ Perl_yylex(pTHX)
                /* Call it a bare word */
 
                if (PL_hints & HINT_STRICT_SUBS)
                /* Call it a bare word */
 
                if (PL_hints & HINT_STRICT_SUBS)
-                   yylval.opval->op_private |= OPpCONST_STRICT;
+                   pl_yylval.opval->op_private |= OPpCONST_STRICT;
                else {
                bareword:
                else {
                bareword:
+                   /* after "print" and similar functions (corresponding to
+                    * "F? L" in opcode.pl), whatever wasn't already parsed as
+                    * a filehandle should be subject to "strict subs".
+                    * Likewise for the optional indirect-object argument to system
+                    * or exec, which can't be a bareword */
+                   if ((PL_last_lop_op == OP_PRINT
+                           || PL_last_lop_op == OP_PRTF
+                           || PL_last_lop_op == OP_SAY
+                           || PL_last_lop_op == OP_SYSTEM
+                           || PL_last_lop_op == OP_EXEC)
+                           && (PL_hints & HINT_STRICT_SUBS))
+                       pl_yylval.opval->op_private |= OPpCONST_STRICT;
                    if (lastchar != '-') {
                        if (ckWARN(WARN_RESERVED)) {
                            d = PL_tokenbuf;
                    if (lastchar != '-') {
                        if (ckWARN(WARN_RESERVED)) {
                            d = PL_tokenbuf;
@@ -5618,17 +5743,17 @@ Perl_yylex(pTHX)
            }
 
        case KEY___FILE__:
            }
 
        case KEY___FILE__:
-           yylval.opval = (OP*)newSVOP(OP_CONST, 0,
+           pl_yylval.opval = (OP*)newSVOP(OP_CONST, 0,
                                        newSVpv(CopFILE(PL_curcop),0));
            TERM(THING);
 
        case KEY___LINE__:
                                        newSVpv(CopFILE(PL_curcop),0));
            TERM(THING);
 
        case KEY___LINE__:
-            yylval.opval = (OP*)newSVOP(OP_CONST, 0,
+            pl_yylval.opval = (OP*)newSVOP(OP_CONST, 0,
                                     Perl_newSVpvf(aTHX_ "%"IVdf, (IV)CopLINE(PL_curcop)));
            TERM(THING);
 
        case KEY___PACKAGE__:
                                     Perl_newSVpvf(aTHX_ "%"IVdf, (IV)CopLINE(PL_curcop)));
            TERM(THING);
 
        case KEY___PACKAGE__:
-           yylval.opval = (OP*)newSVOP(OP_CONST, 0,
+           pl_yylval.opval = (OP*)newSVOP(OP_CONST, 0,
                                        (PL_curstash
                                         ? newSVhek(HvNAME_HEK(PL_curstash))
                                         : &PL_sv_undef));
                                        (PL_curstash
                                         ? newSVhek(HvNAME_HEK(PL_curstash))
                                         : &PL_sv_undef));
@@ -5655,9 +5780,7 @@ Perl_yylex(pTHX)
 #endif
                /* Mark this internal pseudo-handle as clean */
                IoFLAGS(GvIOp(gv)) |= IOf_UNTAINT;
 #endif
                /* Mark this internal pseudo-handle as clean */
                IoFLAGS(GvIOp(gv)) |= IOf_UNTAINT;
-               if (PL_preprocess)
-                   IoTYPE(GvIOp(gv)) = IoTYPE_PIPE;
-               else if ((PerlIO*)PL_rsfp == PerlIO_stdin())
+               if ((PerlIO*)PL_rsfp == PerlIO_stdin())
                    IoTYPE(GvIOp(gv)) = IoTYPE_STD;
                else
                    IoTYPE(GvIOp(gv)) = IoTYPE_RDONLY;
                    IoTYPE(GvIOp(gv)) = IoTYPE_STD;
                else
                    IoTYPE(GvIOp(gv)) = IoTYPE_RDONLY;
@@ -5726,7 +5849,7 @@ Perl_yylex(pTHX)
                        PL_realtokenstart = -1;
                    }
                    while ((s = filter_gets(PL_endwhite, PL_rsfp,
                        PL_realtokenstart = -1;
                    }
                    while ((s = filter_gets(PL_endwhite, PL_rsfp,
-                                SvCUR(PL_endwhite))) != Nullch) ;
+                                SvCUR(PL_endwhite))) != NULL) ;
                }
 #endif
                PL_rsfp = NULL;
                }
 #endif
                PL_rsfp = NULL;
@@ -5868,10 +5991,10 @@ Perl_yylex(pTHX)
                s = force_word(s,WORD,TRUE,TRUE,FALSE);
            if (orig_keyword == KEY_do) {
                orig_keyword = 0;
                s = force_word(s,WORD,TRUE,TRUE,FALSE);
            if (orig_keyword == KEY_do) {
                orig_keyword = 0;
-               yylval.ival = 1;
+               pl_yylval.ival = 1;
            }
            else
            }
            else
-               yylval.ival = 0;
+               pl_yylval.ival = 0;
            OPERATOR(DO);
 
        case KEY_die:
            OPERATOR(DO);
 
        case KEY_die:
@@ -5899,7 +6022,7 @@ Perl_yylex(pTHX)
            PREBLOCK(ELSE);
 
        case KEY_elsif:
            PREBLOCK(ELSE);
 
        case KEY_elsif:
-           yylval.ival = CopLINE(PL_curcop);
+           pl_yylval.ival = CopLINE(PL_curcop);
            OPERATOR(ELSIF);
 
        case KEY_eq:
            OPERATOR(ELSIF);
 
        case KEY_eq:
@@ -5921,9 +6044,6 @@ Perl_yylex(pTHX)
        case KEY_eof:
            UNI(OP_EOF);
 
        case KEY_eof:
            UNI(OP_EOF);
 
-       case KEY_err:
-           OPERATOR(DOROP);
-
        case KEY_exp:
            UNI(OP_EXP);
 
        case KEY_exp:
            UNI(OP_EXP);
 
@@ -5931,7 +6051,6 @@ Perl_yylex(pTHX)
            UNI(OP_EACH);
 
        case KEY_exec:
            UNI(OP_EACH);
 
        case KEY_exec:
-           set_csh();
            LOP(OP_EXEC,XREF);
 
        case KEY_endhostent:
            LOP(OP_EXEC,XREF);
 
        case KEY_endhostent:
@@ -5954,7 +6073,7 @@ Perl_yylex(pTHX)
 
        case KEY_for:
        case KEY_foreach:
 
        case KEY_for:
        case KEY_foreach:
-           yylval.ival = CopLINE(PL_curcop);
+           pl_yylval.ival = CopLINE(PL_curcop);
            s = SKIPSPACE1(s);
            if (PL_expect == XSTATE && isIDFIRST_lazy_if(s,UTF)) {
                char *p = s;
            s = SKIPSPACE1(s);
            if (PL_expect == XSTATE && isIDFIRST_lazy_if(s,UTF)) {
                char *p = s;
@@ -6092,18 +6211,17 @@ Perl_yylex(pTHX)
            FUN0(OP_GETLOGIN);
 
        case KEY_given:
            FUN0(OP_GETLOGIN);
 
        case KEY_given:
-           yylval.ival = CopLINE(PL_curcop);
+           pl_yylval.ival = CopLINE(PL_curcop);
            OPERATOR(GIVEN);
 
        case KEY_glob:
            OPERATOR(GIVEN);
 
        case KEY_glob:
-           set_csh();
            LOP(OP_GLOB,XTERM);
 
        case KEY_hex:
            UNI(OP_HEX);
 
        case KEY_if:
            LOP(OP_GLOB,XTERM);
 
        case KEY_hex:
            UNI(OP_HEX);
 
        case KEY_if:
-           yylval.ival = CopLINE(PL_curcop);
+           pl_yylval.ival = CopLINE(PL_curcop);
            OPERATOR(IF);
 
        case KEY_index:
            OPERATOR(IF);
 
        case KEY_index:
@@ -6135,7 +6253,7 @@ Perl_yylex(pTHX)
            UNI(OP_LCFIRST);
 
        case KEY_local:
            UNI(OP_LCFIRST);
 
        case KEY_local:
-           yylval.ival = 0;
+           pl_yylval.ival = 0;
            OPERATOR(LOCAL);
 
        case KEY_length:
            OPERATOR(LOCAL);
 
        case KEY_length:
@@ -6214,7 +6332,7 @@ Perl_yylex(pTHX)
                }
 #endif
            }
                }
 #endif
            }
-           yylval.ival = 1;
+           pl_yylval.ival = 1;
            OPERATOR(MY);
 
        case KEY_next:
            OPERATOR(MY);
 
        case KEY_next:
@@ -6255,7 +6373,7 @@ Perl_yylex(pTHX)
            LOP(OP_OPEN,XTERM);
 
        case KEY_or:
            LOP(OP_OPEN,XTERM);
 
        case KEY_or:
-           yylval.ival = OP_OR;
+           pl_yylval.ival = OP_OR;
            OPERATOR(OROP);
 
        case KEY_ord:
            OPERATOR(OROP);
 
        case KEY_ord:
@@ -6301,7 +6419,7 @@ Perl_yylex(pTHX)
            s = scan_str(s,!!PL_madskills,FALSE);
            if (!s)
                missingterm(NULL);
            s = scan_str(s,!!PL_madskills,FALSE);
            if (!s)
                missingterm(NULL);
-           yylval.ival = OP_CONST;
+           pl_yylval.ival = OP_CONST;
            TERM(sublex_start());
 
        case KEY_quotemeta:
            TERM(sublex_start());
 
        case KEY_quotemeta:
@@ -6341,9 +6459,7 @@ Perl_yylex(pTHX)
                            for (; !isSPACE(*d) && len; --len, ++d)
                                /**/;
                        }
                            for (; !isSPACE(*d) && len; --len, ++d)
                                /**/;
                        }
-                       sv = newSVpvn(b, d-b);
-                       if (DO_UTF8(PL_lex_stuff))
-                           SvUTF8_on(sv);
+                       sv = newSVpvn_utf8(b, d-b, DO_UTF8(PL_lex_stuff));
                        words = append_elem(OP_LIST, words,
                                            newSVOP(OP_CONST, 0, tokeq(sv)));
                    }
                        words = append_elem(OP_LIST, words,
                                            newSVOP(OP_CONST, 0, tokeq(sv)));
                    }
@@ -6365,7 +6481,7 @@ Perl_yylex(pTHX)
            s = scan_str(s,!!PL_madskills,FALSE);
            if (!s)
                missingterm(NULL);
            s = scan_str(s,!!PL_madskills,FALSE);
            if (!s)
                missingterm(NULL);
-           yylval.ival = OP_STRINGIFY;
+           pl_yylval.ival = OP_STRINGIFY;
            if (SvIVX(PL_lex_stuff) == '\'')
                SvIV_set(PL_lex_stuff, 0);      /* qq'$foo' should intepolate */
            TERM(sublex_start());
            if (SvIVX(PL_lex_stuff) == '\'')
                SvIV_set(PL_lex_stuff, 0);      /* qq'$foo' should intepolate */
            TERM(sublex_start());
@@ -6401,10 +6517,10 @@ Perl_yylex(pTHX)
            }
            if (orig_keyword == KEY_require) {
                orig_keyword = 0;
            }
            if (orig_keyword == KEY_require) {
                orig_keyword = 0;
-               yylval.ival = 1;
+               pl_yylval.ival = 1;
            }
            else 
            }
            else 
-               yylval.ival = 0;
+               pl_yylval.ival = 0;
            PL_expect = XTERM;
            PL_bufptr = s;
            PL_last_uni = PL_oldbufptr;
            PL_expect = XTERM;
            PL_bufptr = s;
            PL_last_uni = PL_oldbufptr;
@@ -6438,11 +6554,9 @@ Perl_yylex(pTHX)
            UNI(OP_READDIR);
 
        case KEY_readline:
            UNI(OP_READDIR);
 
        case KEY_readline:
-           set_csh();
            UNIDOR(OP_READLINE);
 
        case KEY_readpipe:
            UNIDOR(OP_READLINE);
 
        case KEY_readpipe:
-           set_csh();
            UNIDOR(OP_BACKTICK);
 
        case KEY_rewinddir:
            UNIDOR(OP_BACKTICK);
 
        case KEY_rewinddir:
@@ -6462,7 +6576,7 @@ Perl_yylex(pTHX)
 
        case KEY_s:
            s = scan_subst(s);
 
        case KEY_s:
            s = scan_subst(s);
-           if (yylval.opval)
+           if (pl_yylval.opval)
                TERM(sublex_start());
            else
                TOKEN(1);       /* force error */
                TERM(sublex_start());
            else
                TOKEN(1);       /* force error */
@@ -6615,7 +6729,7 @@ Perl_yylex(pTHX)
                    (*s == ':' && s[1] == ':'))
                {
 #ifdef PERL_MAD
                    (*s == ':' && s[1] == ':'))
                {
 #ifdef PERL_MAD
-                   SV *nametoke;
+                   SV *nametoke = NULL;
 #endif
 
                    PL_expect = XBLOCK;
 #endif
 
                    PL_expect = XBLOCK;
@@ -6654,7 +6768,7 @@ Perl_yylex(pTHX)
                        Perl_croak(aTHX_ "Missing name in \"my sub\"");
                    PL_expect = XTERMBLOCK;
                    attrful = XATTRTERM;
                        Perl_croak(aTHX_ "Missing name in \"my sub\"");
                    PL_expect = XTERMBLOCK;
                    attrful = XATTRTERM;
-                   sv_setpvn(PL_subname,"?",1);
+                   sv_setpvs(PL_subname,"?");
                    have_name = FALSE;
                }
 
                    have_name = FALSE;
                }
 
@@ -6676,6 +6790,12 @@ Perl_yylex(pTHX)
                if (*s == '(') {
                    char *p;
                    bool bad_proto = FALSE;
                if (*s == '(') {
                    char *p;
                    bool bad_proto = FALSE;
+                   bool in_brackets = FALSE;
+                   char greedy_proto = ' ';
+                   bool proto_after_greedy_proto = FALSE;
+                   bool must_be_last = FALSE;
+                   bool underscore = FALSE;
+                   bool seen_underscore = FALSE;
                    const bool warnsyntax = ckWARN(WARN_SYNTAX);
 
                    s = scan_str(s,!!PL_madskills,FALSE);
                    const bool warnsyntax = ckWARN(WARN_SYNTAX);
 
                    s = scan_str(s,!!PL_madskills,FALSE);
@@ -6687,14 +6807,47 @@ Perl_yylex(pTHX)
                    for (p = d; *p; ++p) {
                        if (!isSPACE(*p)) {
                            d[tmp++] = *p;
                    for (p = d; *p; ++p) {
                        if (!isSPACE(*p)) {
                            d[tmp++] = *p;
-                           if (warnsyntax && !strchr("$@%*;[]&\\_", *p))
-                               bad_proto = TRUE;
+
+                           if (warnsyntax) {
+                               if (must_be_last)
+                                   proto_after_greedy_proto = TRUE;
+                               if (!strchr("$@%*;[]&\\_", *p)) {
+                                   bad_proto = TRUE;
+                               }
+                               else {
+                                   if ( underscore ) {
+                                       if ( *p != ';' )
+                                           bad_proto = TRUE;
+                                       underscore = FALSE;
+                                   }
+                                   if ( *p == '[' ) {
+                                       in_brackets = TRUE;
+                                   }
+                                   else if ( *p == ']' ) {
+                                       in_brackets = FALSE;
+                                   }
+                                   else if ( (*p == '@' || *p == '%') &&
+                                        ( tmp < 2 || d[tmp-2] != '\\' ) &&
+                                        !in_brackets ) {
+                                       must_be_last = TRUE;
+                                       greedy_proto = *p;
+                                   }
+                                   else if ( *p == '_' ) {
+                                       underscore = seen_underscore = TRUE;
+                                   }
+                               }
+                           }
                        }
                    }
                    d[tmp] = '\0';
                        }
                    }
                    d[tmp] = '\0';
+                   if (proto_after_greedy_proto)
+                       Perl_warner(aTHX_ packWARN(WARN_SYNTAX),
+                                   "Prototype after '%c' for %"SVf" : %s",
+                                   greedy_proto, SVfARG(PL_subname), d);
                    if (bad_proto)
                        Perl_warner(aTHX_ packWARN(WARN_SYNTAX),
                    if (bad_proto)
                        Perl_warner(aTHX_ packWARN(WARN_SYNTAX),
-                                   "Illegal character in prototype for %"SVf" : %s",
+                                   "Illegal character %sin prototype for %"SVf" : %s",
+                                   seen_underscore ? "after '_' " : "",
                                    SVfARG(PL_subname), d);
                    SvCUR_set(PL_lex_stuff, tmp);
                    have_proto = TRUE;
                                    SVfARG(PL_subname), d);
                    SvCUR_set(PL_lex_stuff, tmp);
                    have_proto = TRUE;
@@ -6707,7 +6860,7 @@ Perl_yylex(pTHX)
                    CURMAD('Q', PL_thisclose);
                    NEXTVAL_NEXTTOKE.opval =
                        (OP*)newSVOP(OP_CONST, 0, PL_lex_stuff);
                    CURMAD('Q', PL_thisclose);
                    NEXTVAL_NEXTTOKE.opval =
                        (OP*)newSVOP(OP_CONST, 0, PL_lex_stuff);
-                   PL_lex_stuff = Nullsv;
+                   PL_lex_stuff = NULL;
                    force_next(THING);
 
                    s = SKIPSPACE2(s,tmpwhite);
                    force_next(THING);
 
                    s = SKIPSPACE2(s,tmpwhite);
@@ -6746,9 +6899,10 @@ Perl_yylex(pTHX)
                }
 #endif
                if (!have_name) {
                }
 #endif
                if (!have_name) {
-                   sv_setpv(PL_subname,
-                            (const char *)
-                            (PL_curstash ? "__ANON__" : "__ANON__::__ANON__"));
+                   if (PL_curstash)
+                       sv_setpvs(PL_subname, "__ANON__");
+                   else
+                       sv_setpvs(PL_subname, "__ANON__::__ANON__");
                    TOKEN(ANONSUB);
                }
 #ifndef PERL_MAD
                    TOKEN(ANONSUB);
                }
 #ifndef PERL_MAD
@@ -6761,7 +6915,6 @@ Perl_yylex(pTHX)
            }
 
        case KEY_system:
            }
 
        case KEY_system:
-           set_csh();
            LOP(OP_SYSTEM,XREF);
 
        case KEY_symlink:
            LOP(OP_SYSTEM,XREF);
 
        case KEY_symlink:
@@ -6817,11 +6970,11 @@ Perl_yylex(pTHX)
            UNI(OP_UNTIE);
 
        case KEY_until:
            UNI(OP_UNTIE);
 
        case KEY_until:
-           yylval.ival = CopLINE(PL_curcop);
+           pl_yylval.ival = CopLINE(PL_curcop);
            OPERATOR(UNTIL);
 
        case KEY_unless:
            OPERATOR(UNTIL);
 
        case KEY_unless:
-           yylval.ival = CopLINE(PL_curcop);
+           pl_yylval.ival = CopLINE(PL_curcop);
            OPERATOR(UNLESS);
 
        case KEY_unlink:
            OPERATOR(UNLESS);
 
        case KEY_unlink:
@@ -6853,11 +7006,11 @@ Perl_yylex(pTHX)
            LOP(OP_VEC,XTERM);
 
        case KEY_when:
            LOP(OP_VEC,XTERM);
 
        case KEY_when:
-           yylval.ival = CopLINE(PL_curcop);
+           pl_yylval.ival = CopLINE(PL_curcop);
            OPERATOR(WHEN);
 
        case KEY_while:
            OPERATOR(WHEN);
 
        case KEY_while:
-           yylval.ival = CopLINE(PL_curcop);
+           pl_yylval.ival = CopLINE(PL_curcop);
            OPERATOR(WHILE);
 
        case KEY_warn:
            OPERATOR(WHILE);
 
        case KEY_warn:
@@ -6894,7 +7047,7 @@ Perl_yylex(pTHX)
            goto just_a_word;
 
        case KEY_xor:
            goto just_a_word;
 
        case KEY_xor:
-           yylval.ival = OP_XOR;
+           pl_yylval.ival = OP_XOR;
            OPERATOR(OROP);
 
        case KEY_y:
            OPERATOR(OROP);
 
        case KEY_y:
@@ -6915,6 +7068,9 @@ S_pending_ident(pTHX)
     PADOFFSET tmp = 0;
     /* pit holds the identifier we read and pending_ident is reset */
     char pit = PL_pending_ident;
     PADOFFSET tmp = 0;
     /* pit holds the identifier we read and pending_ident is reset */
     char pit = PL_pending_ident;
+    const STRLEN tokenbuf_len = strlen(PL_tokenbuf);
+    /* All routes through this function want to know if there is a colon.  */
+    const char *const has_colon = (const char*) memchr (PL_tokenbuf, ':', tokenbuf_len);
     PL_pending_ident = 0;
 
     /* PL_realtokenstart = realtokenend = PL_bufptr - SvPVX(PL_linestr); */
     PL_pending_ident = 0;
 
     /* PL_realtokenstart = realtokenend = PL_bufptr - SvPVX(PL_linestr); */
@@ -6929,19 +7085,19 @@ S_pending_ident(pTHX)
     */
     if (PL_in_my) {
         if (PL_in_my == KEY_our) {     /* "our" is merely analogous to "my" */
     */
     if (PL_in_my) {
         if (PL_in_my == KEY_our) {     /* "our" is merely analogous to "my" */
-            if (strchr(PL_tokenbuf,':'))
+            if (has_colon)
                 yyerror(Perl_form(aTHX_ "No package name allowed for "
                                   "variable %s in \"our\"",
                                   PL_tokenbuf));
             tmp = allocmy(PL_tokenbuf);
         }
         else {
                 yyerror(Perl_form(aTHX_ "No package name allowed for "
                                   "variable %s in \"our\"",
                                   PL_tokenbuf));
             tmp = allocmy(PL_tokenbuf);
         }
         else {
-            if (strchr(PL_tokenbuf,':'))
+            if (has_colon)
                 yyerror(Perl_form(aTHX_ PL_no_myglob,
                            PL_in_my == KEY_my ? "my" : "state", PL_tokenbuf));
 
                 yyerror(Perl_form(aTHX_ PL_no_myglob,
                            PL_in_my == KEY_my ? "my" : "state", PL_tokenbuf));
 
-            yylval.opval = newOP(OP_PADANY, 0);
-            yylval.opval->op_targ = allocmy(PL_tokenbuf);
+            pl_yylval.opval = newOP(OP_PADANY, 0);
+            pl_yylval.opval->op_targ = allocmy(PL_tokenbuf);
             return PRIVATEREF;
         }
     }
             return PRIVATEREF;
         }
     }
@@ -6958,7 +7114,7 @@ S_pending_ident(pTHX)
        (although why you'd do that is anyone's guess).
     */
 
        (although why you'd do that is anyone's guess).
     */
 
-    if (!strchr(PL_tokenbuf,':')) {
+    if (!has_colon) {
        if (!PL_in_my)
            tmp = pad_findmy(PL_tokenbuf);
         if (tmp != NOT_IN_PAD) {
        if (!PL_in_my)
            tmp = pad_findmy(PL_tokenbuf);
         if (tmp != NOT_IN_PAD) {
@@ -6969,9 +7125,9 @@ S_pending_ident(pTHX)
                HEK * const stashname = HvNAME_HEK(stash);
                SV *  const sym = newSVhek(stashname);
                 sv_catpvs(sym, "::");
                HEK * const stashname = HvNAME_HEK(stash);
                SV *  const sym = newSVhek(stashname);
                 sv_catpvs(sym, "::");
-                sv_catpv(sym, PL_tokenbuf+1);
-                yylval.opval = (OP*)newSVOP(OP_CONST, 0, sym);
-                yylval.opval->op_private = OPpCONST_ENTERED;
+                sv_catpvn(sym, PL_tokenbuf+1, tokenbuf_len - 1);
+                pl_yylval.opval = (OP*)newSVOP(OP_CONST, 0, sym);
+                pl_yylval.opval->op_private = OPpCONST_ENTERED;
                 gv_fetchsv(sym,
                     (PL_in_eval
                         ? (GV_ADDMULTI | GV_ADDINEVAL)
                 gv_fetchsv(sym,
                     (PL_in_eval
                         ? (GV_ADDMULTI | GV_ADDINEVAL)
@@ -7000,8 +7156,8 @@ S_pending_ident(pTHX)
                 }
             }
 
                 }
             }
 
-            yylval.opval = newOP(OP_PADANY, 0);
-            yylval.opval->op_targ = tmp;
+            pl_yylval.opval = newOP(OP_PADANY, 0);
+            pl_yylval.opval->op_targ = tmp;
             return PRIVATEREF;
         }
     }
             return PRIVATEREF;
         }
     }
@@ -7012,7 +7168,8 @@ S_pending_ident(pTHX)
        table.
     */
     if (pit == '@' && PL_lex_state != LEX_NORMAL && !PL_lex_brackets) {
        table.
     */
     if (pit == '@' && PL_lex_state != LEX_NORMAL && !PL_lex_brackets) {
-        GV *gv = gv_fetchpv(PL_tokenbuf+1, 0, SVt_PVAV);
+        GV *const gv = gv_fetchpvn_flags(PL_tokenbuf + 1, tokenbuf_len - 1, 0,
+                                        SVt_PVAV);
         if ((!gv || ((PL_tokenbuf[0] == '@') ? !GvAV(gv) : !GvHV(gv)))
                && ckWARN(WARN_AMBIGUOUS)
                /* DO NOT warn for @- and @+ */
         if ((!gv || ((PL_tokenbuf[0] == '@') ? !GvAV(gv) : !GvHV(gv)))
                && ckWARN(WARN_AMBIGUOUS)
                /* DO NOT warn for @- and @+ */
@@ -7028,10 +7185,11 @@ S_pending_ident(pTHX)
     }
 
     /* build ops for a bareword */
     }
 
     /* build ops for a bareword */
-    yylval.opval = (OP*)newSVOP(OP_CONST, 0, newSVpv(PL_tokenbuf+1, 0));
-    yylval.opval->op_private = OPpCONST_ENTERED;
-    gv_fetchpv(
-           PL_tokenbuf+1,
+    pl_yylval.opval = (OP*)newSVOP(OP_CONST, 0, newSVpvn(PL_tokenbuf + 1,
+                                                     tokenbuf_len - 1));
+    pl_yylval.opval->op_private = OPpCONST_ENTERED;
+    gv_fetchpvn_flags(
+           PL_tokenbuf + 1, tokenbuf_len - 1,
            /* If the identifier refers to a stash, don't autovivify it.
             * Change 24660 had the side effect of causing symbol table
             * hashes to always be defined, even if they were freshly
            /* If the identifier refers to a stash, don't autovivify it.
             * Change 24660 had the side effect of causing symbol table
             * hashes to always be defined, even if they were freshly
@@ -7044,7 +7202,9 @@ S_pending_ident(pTHX)
             * tests still give the expected answers, even though what
             * they're actually testing has now changed subtly.
             */
             * tests still give the expected answers, even though what
             * they're actually testing has now changed subtly.
             */
-           (*PL_tokenbuf == '%' && *(d = PL_tokenbuf + strlen(PL_tokenbuf) - 1) == ':' && d[-1] == ':'
+           (*PL_tokenbuf == '%'
+            && *(d = PL_tokenbuf + tokenbuf_len - 1) == ':'
+            && d[-1] == ':'
             ? 0
             : PL_in_eval ? (GV_ADDMULTI | GV_ADDINEVAL) : GV_ADD),
            ((PL_tokenbuf[0] == '$') ? SVt_PV
             ? 0
             : PL_in_eval ? (GV_ADDMULTI | GV_ADDINEVAL) : GV_ADD),
            ((PL_tokenbuf[0] == '$') ? SVt_PV
@@ -7061,6 +7221,9 @@ I32
 Perl_keyword (pTHX_ const char *name, I32 len, bool all_keywords)
 {
     dVAR;
 Perl_keyword (pTHX_ const char *name, I32 len, bool all_keywords)
 {
     dVAR;
+
+    PERL_ARGS_ASSERT_KEYWORD;
+
   switch (len)
   {
     case 1: /* 5 tokens of length 1 */
   switch (len)
   {
     case 1: /* 5 tokens of length 1 */
@@ -7327,14 +7490,6 @@ Perl_keyword (pTHX_ const char *name, I32 len, bool all_keywords)
 
               goto unknown;
 
 
               goto unknown;
 
-            case 'r':
-              if (name[2] == 'r')
-              {                                   /* err        */
-                return (all_keywords || FEATURE_IS_ENABLED("err") ? -KEY_err : 0);
-              }
-
-              goto unknown;
-
             case 'x':
               if (name[2] == 'p')
               {                                   /* exp        */
             case 'x':
               if (name[2] == 'p')
               {                                   /* exp        */
@@ -10457,6 +10612,8 @@ S_checkcomma(pTHX_ const char *s, const char *name, const char *what)
 {
     dVAR;
 
 {
     dVAR;
 
+    PERL_ARGS_ASSERT_CHECKCOMMA;
+
     if (*s == ' ' && s[1] == '(') {    /* XXX gotta be a better way */
        if (ckWARN(WARN_SYNTAX)) {
            int level = 1;
     if (*s == ' ' && s[1] == '(') {    /* XXX gotta be a better way */
        if (ckWARN(WARN_SYNTAX)) {
            int level = 1;
@@ -10509,8 +10666,8 @@ S_checkcomma(pTHX_ const char *s, const char *name, const char *what)
    and type is used with error messages only. */
 
 STATIC SV *
    and type is used with error messages only. */
 
 STATIC SV *
-S_new_constant(pTHX_ const char *s, STRLEN len, const char *key, SV *sv, SV *pv,
-              const char *type)
+S_new_constant(pTHX_ const char *s, STRLEN len, const char *key, STRLEN keylen,
+              SV *sv, SV *pv, const char *type, STRLEN typelen)
 {
     dVAR; dSP;
     HV * const table = GvHV(PL_hintgv);                 /* ^H */
 {
     dVAR; dSP;
     HV * const table = GvHV(PL_hintgv);                 /* ^H */
@@ -10519,6 +10676,8 @@ S_new_constant(pTHX_ const char *s, STRLEN len, const char *key, SV *sv, SV *pv,
     SV *cv, *typesv;
     const char *why1 = "", *why2 = "", *why3 = "";
 
     SV *cv, *typesv;
     const char *why1 = "", *why2 = "", *why3 = "";
 
+    PERL_ARGS_ASSERT_NEW_CONSTANT;
+
     if (!table || !(PL_hints & HINT_LOCALIZE_HH)) {
        SV *msg;
        
     if (!table || !(PL_hints & HINT_LOCALIZE_HH)) {
        SV *msg;
        
@@ -10544,7 +10703,7 @@ S_new_constant(pTHX_ const char *s, STRLEN len, const char *key, SV *sv, SV *pv,
        SvREFCNT_dec(msg);
        return sv;
     }
        SvREFCNT_dec(msg);
        return sv;
     }
-    cvp = hv_fetch(table, key, strlen(key), FALSE);
+    cvp = hv_fetch(table, key, keylen, FALSE);
     if (!cvp || !SvOK(*cvp)) {
        why1 = "$^H{";
        why2 = key;
     if (!cvp || !SvOK(*cvp)) {
        why1 = "$^H{";
        why2 = key;
@@ -10554,9 +10713,9 @@ S_new_constant(pTHX_ const char *s, STRLEN len, const char *key, SV *sv, SV *pv,
     sv_2mortal(sv);                    /* Parent created it permanently */
     cv = *cvp;
     if (!pv && s)
     sv_2mortal(sv);                    /* Parent created it permanently */
     cv = *cvp;
     if (!pv && s)
-       pv = sv_2mortal(newSVpvn(s, len));
+       pv = newSVpvn_flags(s, len, SVs_TEMP);
     if (type && pv)
     if (type && pv)
-       typesv = sv_2mortal(newSVpv(type, 0));
+       typesv = newSVpvn_flags(type, typelen, SVs_TEMP);
     else
        typesv = &PL_sv_undef;
 
     else
        typesv = &PL_sv_undef;
 
@@ -10613,6 +10772,9 @@ S_scan_word(pTHX_ register char *s, char *dest, STRLEN destlen, int allow_packag
     dVAR;
     register char *d = dest;
     register char * const e = d + destlen - 3;  /* two-character token, ending NUL */
     dVAR;
     register char *d = dest;
     register char * const e = d + destlen - 3;  /* two-character token, ending NUL */
+
+    PERL_ARGS_ASSERT_SCAN_WORD;
+
     for (;;) {
        if (d >= e)
            Perl_croak(aTHX_ ident_too_long);
     for (;;) {
        if (d >= e)
            Perl_croak(aTHX_ ident_too_long);
@@ -10656,6 +10818,8 @@ S_scan_ident(pTHX_ register char *s, register const char *send, char *dest, STRL
     register char *d = dest;
     register char * const e = d + destlen + 3;    /* two-character token, ending NUL */
 
     register char *d = dest;
     register char * const e = d + destlen + 3;    /* two-character token, ending NUL */
 
+    PERL_ARGS_ASSERT_SCAN_IDENT;
+
     if (isSPACE(*s))
        s = PEEKSPACE(s);
     if (isDIGIT(*s)) {
     if (isSPACE(*s))
        s = PEEKSPACE(s);
     if (isDIGIT(*s)) {
@@ -10810,9 +10974,11 @@ S_scan_ident(pTHX_ register char *s, register const char *send, char *dest, STRL
 void
 Perl_pmflag(pTHX_ U32* pmfl, int ch)
 {
 void
 Perl_pmflag(pTHX_ U32* pmfl, int ch)
 {
+    PERL_ARGS_ASSERT_PMFLAG;
+
     PERL_UNUSED_CONTEXT;
     if (ch<256) {
     PERL_UNUSED_CONTEXT;
     if (ch<256) {
-        char c = (char)ch;
+        const char c = (char)ch;
         switch (c) {
             CASE_STD_PMMOD_FLAGS_PARSE_SET(pmfl);
             case GLOBAL_PAT_MOD:    *pmfl |= PMf_GLOBAL; break;
         switch (c) {
             CASE_STD_PMMOD_FLAGS_PARSE_SET(pmfl);
             case GLOBAL_PAT_MOD:    *pmfl |= PMf_GLOBAL; break;
@@ -10835,6 +11001,7 @@ S_scan_pat(pTHX_ char *start, I32 type)
     char *modstart;
 #endif
 
     char *modstart;
 #endif
 
+    PERL_ARGS_ASSERT_SCAN_PAT;
 
     if (!s) {
        const char * const delimiter = skipspace(start);
 
     if (!s) {
        const char * const delimiter = skipspace(start);
@@ -10855,10 +11022,10 @@ S_scan_pat(pTHX_ char *start, I32 type)
           matches.  */
        assert(type != OP_TRANS);
        if (PL_curstash) {
           matches.  */
        assert(type != OP_TRANS);
        if (PL_curstash) {
-           MAGIC *mg = mg_find((SV*)PL_curstash, PERL_MAGIC_symtab);
+           MAGIC *mg = mg_find((const SV *)PL_curstash, PERL_MAGIC_symtab);
            U32 elements;
            if (!mg) {
            U32 elements;
            if (!mg) {
-               mg = sv_magicext((SV*)PL_curstash, 0, PERL_MAGIC_symtab, 0, 0,
+               mg = sv_magicext(MUTABLE_SV(PL_curstash), 0, PERL_MAGIC_symtab, 0, 0,
                                 0);
            }
            elements = mg->mg_len / sizeof(PMOP**);
                                 0);
            }
            elements = mg->mg_len / sizeof(PMOP**);
@@ -10888,7 +11055,7 @@ S_scan_pat(pTHX_ char *start, I32 type)
     }
 
     PL_lex_op = (OP*)pm;
     }
 
     PL_lex_op = (OP*)pm;
-    yylval.ival = OP_MATCH;
+    pl_yylval.ival = OP_MATCH;
     return s;
 }
 
     return s;
 }
 
@@ -10904,7 +11071,9 @@ S_scan_subst(pTHX_ char *start)
     char *modstart;
 #endif
 
     char *modstart;
 #endif
 
-    yylval.ival = OP_NULL;
+    PERL_ARGS_ASSERT_SCAN_SUBST;
+
+    pl_yylval.ival = OP_NULL;
 
     s = scan_str(start,!!PL_madskills,FALSE);
 
 
     s = scan_str(start,!!PL_madskills,FALSE);
 
@@ -10975,8 +11144,12 @@ S_scan_subst(pTHX_ char *start)
        PL_sublex_info.super_bufend = PL_bufend;
        PL_multi_end = 0;
        pm->op_pmflags |= PMf_EVAL;
        PL_sublex_info.super_bufend = PL_bufend;
        PL_multi_end = 0;
        pm->op_pmflags |= PMf_EVAL;
-       while (es-- > 0)
-           sv_catpv(repl, (const char *)(es ? "eval " : "do "));
+       while (es-- > 0) {
+           if (es)
+               sv_catpvs(repl, "eval ");
+           else
+               sv_catpvs(repl, "do ");
+       }
        sv_catpvs(repl, "{");
        sv_catsv(repl, PL_lex_repl);
        if (strchr(SvPVX(PL_lex_repl), '#'))
        sv_catpvs(repl, "{");
        sv_catsv(repl, PL_lex_repl);
        if (strchr(SvPVX(PL_lex_repl), '#'))
@@ -10988,7 +11161,7 @@ S_scan_subst(pTHX_ char *start)
     }
 
     PL_lex_op = (OP*)pm;
     }
 
     PL_lex_op = (OP*)pm;
-    yylval.ival = OP_SUBST;
+    pl_yylval.ival = OP_SUBST;
     return s;
 }
 
     return s;
 }
 
@@ -10999,14 +11172,16 @@ S_scan_trans(pTHX_ char *start)
     register char* s;
     OP *o;
     short *tbl;
     register char* s;
     OP *o;
     short *tbl;
-    I32 squash;
-    I32 del;
-    I32 complement;
+    U8 squash;
+    U8 del;
+    U8 complement;
 #ifdef PERL_MAD
     char *modstart;
 #endif
 
 #ifdef PERL_MAD
     char *modstart;
 #endif
 
-    yylval.ival = OP_NULL;
+    PERL_ARGS_ASSERT_SCAN_TRANS;
+
+    pl_yylval.ival = OP_NULL;
 
     s = scan_str(start,!!PL_madskills,FALSE);
     if (!s)
 
     s = scan_str(start,!!PL_madskills,FALSE);
     if (!s)
@@ -11068,7 +11243,7 @@ S_scan_trans(pTHX_ char *start)
       (DO_UTF8(PL_lex_repl) ? OPpTRANS_TO_UTF   : 0);
 
     PL_lex_op = o;
       (DO_UTF8(PL_lex_repl) ? OPpTRANS_TO_UTF   : 0);
 
     PL_lex_op = o;
-    yylval.ival = OP_TRANS;
+    pl_yylval.ival = OP_TRANS;
 
 #ifdef PERL_MAD
     if (PL_madskills) {
 
 #ifdef PERL_MAD
     if (PL_madskills) {
@@ -11103,6 +11278,8 @@ S_scan_heredoc(pTHX_ register char *s)
     PL_realtokenstart = -1;
 #endif
 
     PL_realtokenstart = -1;
 #endif
 
+    PERL_ARGS_ASSERT_SCAN_HEREDOC;
+
     s += 2;
     d = PL_tokenbuf;
     e = PL_tokenbuf + sizeof PL_tokenbuf - 1;
     s += 2;
     d = PL_tokenbuf;
     e = PL_tokenbuf + sizeof PL_tokenbuf - 1;
@@ -11274,7 +11451,7 @@ S_scan_heredoc(pTHX_ register char *s)
        PL_last_lop = PL_last_uni = NULL;
     }
     else
        PL_last_lop = PL_last_uni = NULL;
     }
     else
-       sv_setpvn(tmpstr,"",0);   /* avoid "uninitialized" warning */
+       sv_setpvs(tmpstr,"");   /* avoid "uninitialized" warning */
     while (s >= PL_bufend) {   /* multiple line string? */
 #ifdef PERL_MAD
        if (PL_madskills) {
     while (s >= PL_bufend) {   /* multiple line string? */
 #ifdef PERL_MAD
        if (PL_madskills) {
@@ -11311,7 +11488,7 @@ S_scan_heredoc(pTHX_ register char *s)
        else if (PL_bufend - PL_linestart == 1 && PL_bufend[-1] == '\r')
            PL_bufend[-1] = '\n';
 #endif
        else if (PL_bufend - PL_linestart == 1 && PL_bufend[-1] == '\r')
            PL_bufend[-1] = '\n';
 #endif
-       if (PERLDB_LINE && PL_curstash != PL_debstash)
+       if ((PERLDB_LINE || PERLDB_SAVESRC) && PL_curstash != PL_debstash)
            update_debugger_info(PL_linestr, NULL, 0);
        if (*s == term && memEQ(s,PL_tokenbuf,len)) {
            STRLEN off = PL_bufend - 1 - SvPVX_const(PL_linestr);
            update_debugger_info(PL_linestr, NULL, 0);
        if (*s == term && memEQ(s,PL_tokenbuf,len)) {
            STRLEN off = PL_bufend - 1 - SvPVX_const(PL_linestr);
@@ -11339,14 +11516,14 @@ retval:
            sv_recode_to_utf8(tmpstr, PL_encoding);
     }
     PL_lex_stuff = tmpstr;
            sv_recode_to_utf8(tmpstr, PL_encoding);
     }
     PL_lex_stuff = tmpstr;
-    yylval.ival = op_type;
+    pl_yylval.ival = op_type;
     return s;
 }
 
 /* scan_inputsymbol
    takes: current position in input buffer
    returns: new position in input buffer
     return s;
 }
 
 /* scan_inputsymbol
    takes: current position in input buffer
    returns: new position in input buffer
-   side-effects: yylval and lex_op are set.
+   side-effects: pl_yylval and lex_op are set.
 
    This code handles:
 
 
    This code handles:
 
@@ -11366,10 +11543,11 @@ S_scan_inputsymbol(pTHX_ char *start)
     register char *s = start;          /* current position in buffer */
     char *end;
     I32 len;
     register char *s = start;          /* current position in buffer */
     char *end;
     I32 len;
-
     char *d = PL_tokenbuf;                                     /* start of temp holding space */
     const char * const e = PL_tokenbuf + sizeof PL_tokenbuf;   /* end of temp holding space */
 
     char *d = PL_tokenbuf;                                     /* start of temp holding space */
     const char * const e = PL_tokenbuf + sizeof PL_tokenbuf;   /* end of temp holding space */
 
+    PERL_ARGS_ASSERT_SCAN_INPUTSYMBOL;
+
     end = strchr(s, '\n');
     if (!end)
        end = PL_bufend;
     end = strchr(s, '\n');
     if (!end)
        end = PL_bufend;
@@ -11406,8 +11584,7 @@ S_scan_inputsymbol(pTHX_ char *start)
     */
 
     if (d - PL_tokenbuf != len) {
     */
 
     if (d - PL_tokenbuf != len) {
-       yylval.ival = OP_GLOB;
-       set_csh();
+       pl_yylval.ival = OP_GLOB;
        s = scan_str(start,!!PL_madskills,FALSE);
        if (!s)
           Perl_croak(aTHX_ "Glob not terminated");
        s = scan_str(start,!!PL_madskills,FALSE);
        if (!s)
           Perl_croak(aTHX_ "Glob not terminated");
@@ -11482,8 +11659,8 @@ intro_sym:
            }
            if (!readline_overriden)
                PL_lex_op->op_flags |= OPf_SPECIAL;
            }
            if (!readline_overriden)
                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;
+           /* we created the ops in PL_lex_op, so make pl_yylval.ival a null op */
+           pl_yylval.ival = OP_NULL;
        }
 
        /* If it's none of the above, it must be a literal filehandle
        }
 
        /* If it's none of the above, it must be a literal filehandle
@@ -11496,7 +11673,7 @@ intro_sym:
                            newGVOP(OP_GV, 0, gv),
                            newCVREF(0, newGVOP(OP_GV, 0, gv_readline))))
                : (OP*)newUNOP(OP_READLINE, 0, newGVOP(OP_GV, 0, gv));
                            newGVOP(OP_GV, 0, gv),
                            newCVREF(0, newGVOP(OP_GV, 0, gv_readline))))
                : (OP*)newUNOP(OP_READLINE, 0, newGVOP(OP_GV, 0, gv));
-           yylval.ival = OP_NULL;
+           pl_yylval.ival = OP_NULL;
        }
     }
 
        }
     }
 
@@ -11567,6 +11744,8 @@ S_scan_str(pTHX_ char *start, int keep_quoted, int keep_delims)
     char *tstart;
 #endif
 
     char *tstart;
 #endif
 
+    PERL_ARGS_ASSERT_SCAN_STR;
+
     /* skip space before the delimiter */
     if (isSPACE(*s)) {
        s = PEEKSPACE(s);
     /* skip space before the delimiter */
     if (isSPACE(*s)) {
        s = PEEKSPACE(s);
@@ -11808,7 +11987,7 @@ S_scan_str(pTHX_ char *start, int keep_quoted, int keep_delims)
        CopLINE_inc(PL_curcop);
 
        /* update debugger info */
        CopLINE_inc(PL_curcop);
 
        /* update debugger info */
-       if (PERLDB_LINE && PL_curstash != PL_debstash)
+       if ((PERLDB_LINE || PERLDB_SAVESRC) && PL_curstash != PL_debstash)
            update_debugger_info(PL_linestr, NULL, 0);
 
        /* having changed the buffer, we must update PL_bufend */
            update_debugger_info(PL_linestr, NULL, 0);
 
        /* having changed the buffer, we must update PL_bufend */
@@ -11876,7 +12055,7 @@ S_scan_str(pTHX_ char *start, int keep_quoted, int keep_delims)
   scan_num
   takes: pointer to position in buffer
   returns: pointer to new position in buffer
   scan_num
   takes: pointer to position in buffer
   returns: pointer to new position in buffer
-  side-effects: builds ops for the constant in yylval.op
+  side-effects: builds ops for the constant in pl_yylval.op
 
   Read a number in any of the formats that Perl accepts:
 
 
   Read a number in any of the formats that Perl accepts:
 
@@ -11907,6 +12086,8 @@ Perl_scan_num(pTHX_ const char *start, YYSTYPE* lvalp)
     const char *lastub = NULL;         /* position of last underbar */
     static char const number_too_long[] = "Number too long";
 
     const char *lastub = NULL;         /* position of last underbar */
     static char const number_too_long[] = "Number too long";
 
+    PERL_ARGS_ASSERT_SCAN_NUM;
+
     /* We use the first character to decide what type of number this is */
 
     switch (*s) {
     /* We use the first character to decide what type of number this is */
 
     switch (*s) {
@@ -12086,9 +12267,9 @@ Perl_scan_num(pTHX_ const char *start, YYSTYPE* lvalp)
            }
            if (just_zero && (PL_hints & HINT_NEW_INTEGER))
                sv = new_constant(start, s - start, "integer",
            }
            if (just_zero && (PL_hints & HINT_NEW_INTEGER))
                sv = new_constant(start, s - start, "integer",
-                                 sv, NULL, NULL);
+                                 sv, NULL, NULL, 0);
            else if (PL_hints & HINT_NEW_BINARY)
            else if (PL_hints & HINT_NEW_BINARY)
-               sv = new_constant(start, s - start, "binary", sv, NULL, NULL);
+               sv = new_constant(start, s - start, "binary", sv, NULL, NULL, 0);
        }
        break;
 
        }
        break;
 
@@ -12251,13 +12432,13 @@ Perl_scan_num(pTHX_ const char *start, YYSTYPE* lvalp)
            sv_setnv(sv, nv);
        }
 
            sv_setnv(sv, nv);
        }
 
-       if ( floatit ? (PL_hints & HINT_NEW_FLOAT) :
-                      (PL_hints & HINT_NEW_INTEGER) )
-           sv = new_constant(PL_tokenbuf,
-                             d - PL_tokenbuf,
-                             (const char *)
-                             (floatit ? "float" : "integer"),
-                             sv, NULL, NULL);
+       if ( floatit
+            ? (PL_hints & HINT_NEW_FLOAT) : (PL_hints & HINT_NEW_INTEGER) ) {
+           const char *const key = floatit ? "float" : "integer";
+           const STRLEN keylen = floatit ? 5 : 7;
+           sv = S_new_constant(aTHX_ PL_tokenbuf, d - PL_tokenbuf,
+                               key, keylen, sv, NULL, NULL, 0);
+       }
        break;
 
     /* if it starts with a v, it could be a v-string */
        break;
 
     /* if it starts with a v, it could be a v-string */
@@ -12289,14 +12470,16 @@ S_scan_formline(pTHX_ register char *s)
     bool eofmt = FALSE;
 #ifdef PERL_MAD
     char *tokenstart = s;
     bool eofmt = FALSE;
 #ifdef PERL_MAD
     char *tokenstart = s;
-    SV* savewhite;
-    
+    SV* savewhite = NULL;
+
     if (PL_madskills) {
        savewhite = PL_thiswhite;
        PL_thiswhite = 0;
     }
 #endif
 
     if (PL_madskills) {
        savewhite = PL_thiswhite;
        PL_thiswhite = 0;
     }
 #endif
 
+    PERL_ARGS_ASSERT_SCAN_FORMLINE;
+
     while (!needargs) {
        if (*s == '.') {
            t = s+1;
     while (!needargs) {
        if (*s == '.') {
            t = s+1;
@@ -12409,20 +12592,6 @@ S_scan_formline(pTHX_ register char *s)
     return s;
 }
 
     return s;
 }
 
-STATIC void
-S_set_csh(pTHX)
-{
-#ifdef CSH
-    dVAR;
-    if (!PL_cshlen)
-       PL_cshlen = strlen(PL_cshname);
-#else
-#if defined(USE_ITHREADS)
-    PERL_UNUSED_CONTEXT;
-#endif
-#endif
-}
-
 I32
 Perl_start_subparse(pTHX_ I32 is_format, U32 flags)
 {
 I32
 Perl_start_subparse(pTHX_ I32 is_format, U32 flags)
 {
@@ -12437,12 +12606,12 @@ Perl_start_subparse(pTHX_ I32 is_format, U32 flags)
     save_item(PL_subname);
     SAVESPTR(PL_compcv);
 
     save_item(PL_subname);
     SAVESPTR(PL_compcv);
 
-    PL_compcv = (CV*)newSV_type(is_format ? SVt_PVFM : SVt_PVCV);
+    PL_compcv = MUTABLE_CV(newSV_type(is_format ? SVt_PVFM : SVt_PVCV));
     CvFLAGS(PL_compcv) |= flags;
 
     PL_subline = CopLINE(PL_curcop);
     CvPADLIST(PL_compcv) = pad_new(padnew_SAVE|padnew_SAVESUB);
     CvFLAGS(PL_compcv) |= flags;
 
     PL_subline = CopLINE(PL_curcop);
     CvPADLIST(PL_compcv) = pad_new(padnew_SAVE|padnew_SAVESUB);
-    CvOUTSIDE(PL_compcv) = (CV*)SvREFCNT_inc_simple(outsidecv);
+    CvOUTSIDE(PL_compcv) = MUTABLE_CV(SvREFCNT_inc_simple(outsidecv));
     CvOUTSIDE_SEQ(PL_compcv) = PL_cop_seqmax;
 
     return oldsavestack_ix;
     CvOUTSIDE_SEQ(PL_compcv) = PL_cop_seqmax;
 
     return oldsavestack_ix;
@@ -12451,10 +12620,13 @@ Perl_start_subparse(pTHX_ I32 is_format, U32 flags)
 #ifdef __SC__
 #pragma segment Perl_yylex
 #endif
 #ifdef __SC__
 #pragma segment Perl_yylex
 #endif
-int
-Perl_yywarn(pTHX_ const char *s)
+static int
+S_yywarn(pTHX_ const char *const s)
 {
     dVAR;
 {
     dVAR;
+
+    PERL_ARGS_ASSERT_YYWARN;
+
     PL_in_eval |= EVAL_WARNONLY;
     yyerror(s);
     PL_in_eval &= ~EVAL_WARNONLY;
     PL_in_eval |= EVAL_WARNONLY;
     yyerror(s);
     PL_in_eval &= ~EVAL_WARNONLY;
@@ -12462,7 +12634,7 @@ Perl_yywarn(pTHX_ const char *s)
 }
 
 int
 }
 
 int
-Perl_yyerror(pTHX_ const char *s)
+Perl_yyerror(pTHX_ const char *const s)
 {
     dVAR;
     const char *where = NULL;
 {
     dVAR;
     const char *where = NULL;
@@ -12471,6 +12643,8 @@ Perl_yyerror(pTHX_ const char *s)
     SV *msg;
     int yychar  = PL_parser->yychar;
 
     SV *msg;
     int yychar  = PL_parser->yychar;
 
+    PERL_ARGS_ASSERT_YYERROR;
+
     if (!yychar || (yychar == ';' && !PL_rsfp))
        where = "at EOF";
     else if (PL_oldoldbufptr && PL_bufptr > PL_oldoldbufptr &&
     if (!yychar || (yychar == ';' && !PL_rsfp))
        where = "at EOF";
     else if (PL_oldoldbufptr && PL_bufptr > PL_oldoldbufptr &&
@@ -12518,11 +12692,13 @@ Perl_yyerror(pTHX_ const char *s)
            where = "within string";
     }
     else {
            where = "within string";
     }
     else {
-       SV * const where_sv = sv_2mortal(newSVpvs("next char "));
+       SV * const where_sv = newSVpvs_flags("next char ", SVs_TEMP);
        if (yychar < 32)
            Perl_sv_catpvf(aTHX_ where_sv, "^%c", toCTRL(yychar));
        if (yychar < 32)
            Perl_sv_catpvf(aTHX_ where_sv, "^%c", toCTRL(yychar));
-       else if (isPRINT_LC(yychar))
-           Perl_sv_catpvf(aTHX_ where_sv, "%c", yychar);
+       else if (isPRINT_LC(yychar)) {
+           const char string = yychar;
+           sv_catpvn(where_sv, &string, 1);
+       }
        else
            Perl_sv_catpvf(aTHX_ where_sv, "\\%03o", yychar & 255);
        where = SvPVX_const(where_sv);
        else
            Perl_sv_catpvf(aTHX_ where_sv, "\\%03o", yychar & 255);
        where = SvPVX_const(where_sv);
@@ -12567,6 +12743,9 @@ S_swallow_bom(pTHX_ U8 *s)
 {
     dVAR;
     const STRLEN slen = SvCUR(PL_linestr);
 {
     dVAR;
     const STRLEN slen = SvCUR(PL_linestr);
+
+    PERL_ARGS_ASSERT_SWALLOW_BOM;
+
     switch (s[0]) {
     case 0xFF:
        if (s[1] == 0xFE) {
     switch (s[0]) {
     case 0xFF:
        if (s[1] == 0xFE) {
@@ -12740,11 +12919,14 @@ passed in, for performance reasons.
 */
 
 char *
 */
 
 char *
-Perl_scan_vstring(pTHX_ const char *s, const char *e, SV *sv)
+Perl_scan_vstring(pTHX_ const char *s, const char *const e, SV *sv)
 {
     dVAR;
     const char *pos = s;
     const char *start = s;
 {
     dVAR;
     const char *pos = s;
     const char *start = s;
+
+    PERL_ARGS_ASSERT_SCAN_VSTRING;
+
     if (*pos == 'v') pos++;  /* get past 'v' */
     while (pos < e && (isDIGIT(*pos) || *pos == '_'))
        pos++;
     if (*pos == 'v') pos++;  /* get past 'v' */
     while (pos < e && (isDIGIT(*pos) || *pos == '_'))
        pos++;
@@ -12766,7 +12948,7 @@ Perl_scan_vstring(pTHX_ const char *s, const char *e, SV *sv)
        if (*s == 'v')
            s++;  /* get past 'v' */
 
        if (*s == 'v')
            s++;  /* get past 'v' */
 
-       sv_setpvn(sv, "", 0);
+       sv_setpvs(sv, "");
 
        for (;;) {
            /* this is atoi() that tolerates underscores */
 
        for (;;) {
            /* this is atoi() that tolerates underscores */
Unnamed repository; edit this file 'description' to name the repository.