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
Floating point too messy.
[perl5.git] / toke.c
diff --git a/toke.c b/toke.c
index b48577e..4e90201 100644 (file)
--- a/toke.c
+++ b/toke.c
@@ -1,6 +1,6 @@
 /*    toke.c
  *
 /*    toke.c
  *
- *    Copyright (c) 1991-2000, Larry Wall
+ *    Copyright (c) 1991-2001, Larry Wall
  *
  *    You may distribute under the terms of either the GNU General Public
  *    License or the Artistic License, as specified in the README file.
  *
  *    You may distribute under the terms of either the GNU General Public
  *    License or the Artistic License, as specified in the README file.
@@ -13,7 +13,7 @@
 
 /*
  * This file is the lexer for Perl.  It's closely linked to the
 
 /*
  * This file is the lexer for Perl.  It's closely linked to the
- * parser, perly.y.  
+ * parser, perly.y.
  *
  * The main routine is yylex(), which returns the next token.
  */
  *
  * The main routine is yylex(), which returns the next token.
  */
@@ -39,7 +39,7 @@ static I32 utf16rev_textfilter(pTHXo_ int idx, SV *sv, int maxlen);
 /*#define UTF (SvUTF8(PL_linestr) && !(PL_hints & HINT_BYTE))*/
 #define UTF (PL_hints & HINT_UTF8)
 
 /*#define UTF (SvUTF8(PL_linestr) && !(PL_hints & HINT_BYTE))*/
 #define UTF (PL_hints & HINT_UTF8)
 
-/* In variables name $^X, these are the legal values for X.  
+/* In variables name $^X, these are the legal values for X.
  * 1999-02-27 mjd-perl-patch@plover.com */
 #define isCONTROLVAR(x) (isUPPER(x) || strchr("[\\]^_?", (x)))
 
  * 1999-02-27 mjd-perl-patch@plover.com */
 #define isCONTROLVAR(x) (isUPPER(x) || strchr("[\\]^_?", (x)))
 
@@ -69,12 +69,6 @@ static I32 utf16rev_textfilter(pTHXo_ int idx, SV *sv, int maxlen);
 #define LEX_FORMLINE            1
 #define LEX_KNOWNEXT            0
 
 #define LEX_FORMLINE            1
 #define LEX_KNOWNEXT            0
 
-/* XXX If this causes problems, set i_unistd=undef in the hint file.  */
-#ifdef I_UNISTD
-#  include <unistd.h> /* Needed for execv() */
-#endif
-
-
 #ifdef ff_next
 #undef ff_next
 #endif
 #ifdef ff_next
 #undef ff_next
 #endif
@@ -85,13 +79,13 @@ static I32 utf16rev_textfilter(pTHXo_ int idx, SV *sv, int maxlen);
 #  endif
 YYSTYPE* yylval_pointer[YYMAXLEVEL];
 int* yychar_pointer[YYMAXLEVEL];
 #  endif
 YYSTYPE* yylval_pointer[YYMAXLEVEL];
 int* yychar_pointer[YYMAXLEVEL];
-int yyactlevel = 0;
+int yyactlevel = -1;
 #  undef yylval
 #  undef yychar
 #  define yylval (*yylval_pointer[yyactlevel])
 #  define yychar (*yychar_pointer[yyactlevel])
 #  define PERL_YYLEX_PARAM yylval_pointer[yyactlevel],yychar_pointer[yyactlevel]
 #  undef yylval
 #  undef yychar
 #  define yylval (*yylval_pointer[yyactlevel])
 #  define yychar (*yychar_pointer[yyactlevel])
 #  define PERL_YYLEX_PARAM yylval_pointer[yyactlevel],yychar_pointer[yyactlevel]
-#  undef yylex 
+#  undef yylex
 #  define yylex()      Perl_yylex_r(aTHX_ yylval_pointer[yyactlevel],yychar_pointer[yyactlevel])
 #endif
 
 #  define yylex()      Perl_yylex_r(aTHX_ yylval_pointer[yyactlevel],yychar_pointer[yyactlevel])
 #endif
 
@@ -127,36 +121,47 @@ int yyactlevel = 0;
  * Aop          : addition-level operator
  * Mop          : multiplication-level operator
  * Eop          : equality-testing operator
  * Aop          : addition-level operator
  * Mop          : multiplication-level operator
  * Eop          : equality-testing operator
- * Rop        : relational operator <= != gt
+ * Rop          : relational operator <= != gt
  *
  * Also see LOP and lop() below.
  */
 
  *
  * Also see LOP and lop() below.
  */
 
-#define TOKEN(retval) return (PL_bufptr = s,(int)retval)
-#define OPERATOR(retval) return (PL_expect = XTERM,PL_bufptr = s,(int)retval)
-#define AOPERATOR(retval) return ao((PL_expect = XTERM,PL_bufptr = s,(int)retval))
-#define PREBLOCK(retval) return (PL_expect = XBLOCK,PL_bufptr = s,(int)retval)
-#define PRETERMBLOCK(retval) return (PL_expect = XTERMBLOCK,PL_bufptr = s,(int)retval)
-#define PREREF(retval) return (PL_expect = XREF,PL_bufptr = s,(int)retval)
-#define TERM(retval) return (CLINE, PL_expect = XOPERATOR,PL_bufptr = s,(int)retval)
-#define LOOPX(f) return(yylval.ival=f,PL_expect = XTERM,PL_bufptr = s,(int)LOOPEX)
-#define FTST(f) return(yylval.ival=f,PL_expect = XTERM,PL_bufptr = s,(int)UNIOP)
-#define FUN0(f) return(yylval.ival = f,PL_expect = XOPERATOR,PL_bufptr = s,(int)FUNC0)
-#define FUN1(f) return(yylval.ival = f,PL_expect = XOPERATOR,PL_bufptr = s,(int)FUNC1)
-#define BOop(f) return ao((yylval.ival=f,PL_expect = XTERM,PL_bufptr = s,(int)BITOROP))
-#define BAop(f) return ao((yylval.ival=f,PL_expect = XTERM,PL_bufptr = s,(int)BITANDOP))
-#define SHop(f) return ao((yylval.ival=f,PL_expect = XTERM,PL_bufptr = s,(int)SHIFTOP))
-#define PWop(f) return ao((yylval.ival=f,PL_expect = XTERM,PL_bufptr = s,(int)POWOP))
-#define PMop(f) return(yylval.ival=f,PL_expect = XTERM,PL_bufptr = s,(int)MATCHOP)
-#define Aop(f) return ao((yylval.ival=f,PL_expect = XTERM,PL_bufptr = s,(int)ADDOP))
-#define Mop(f) return ao((yylval.ival=f,PL_expect = XTERM,PL_bufptr = s,(int)MULOP))
-#define Eop(f) return(yylval.ival=f,PL_expect = XTERM,PL_bufptr = s,(int)EQOP)
-#define Rop(f) return(yylval.ival=f,PL_expect = XTERM,PL_bufptr = s,(int)RELOP)
+/* Note that REPORT() and REPORT2() will be expressions that supply
+ * their own trailing comma, not suitable for statements as such. */
+#ifdef DEBUGGING /* Serve -DT. */
+#   define REPORT(x,retval) tokereport(x,s,(int)retval),
+#   define REPORT2(x,retval) tokereport(x,s, yylval.ival),
+#else
+#   define REPORT(x,retval)
+#   define REPORT2(x,retval)
+#endif
+
+#define TOKEN(retval) return (REPORT2("token",retval) PL_bufptr = s,(int)retval)
+#define OPERATOR(retval) return (REPORT2("operator",retval) PL_expect = XTERM, PL_bufptr = s,(int)retval)
+#define AOPERATOR(retval) return ao((REPORT2("aop",retval) PL_expect = XTERM, PL_bufptr = s,(int)retval))
+#define PREBLOCK(retval) return (REPORT2("preblock",retval) PL_expect = XBLOCK,PL_bufptr = s,(int)retval)
+#define PRETERMBLOCK(retval) return (REPORT2("pretermblock",retval) PL_expect = XTERMBLOCK,PL_bufptr = s,(int)retval)
+#define PREREF(retval) return (REPORT2("preref",retval) PL_expect = XREF,PL_bufptr = s,(int)retval)
+#define TERM(retval) return (CLINE, REPORT2("term",retval) PL_expect = XOPERATOR, PL_bufptr = s,(int)retval)
+#define LOOPX(f) return(yylval.ival=f, REPORT("loopx",f) PL_expect = XTERM,PL_bufptr = s,(int)LOOPEX)
+#define FTST(f) return(yylval.ival=f, REPORT("ftst",f) PL_expect = XTERM,PL_bufptr = s,(int)UNIOP)
+#define FUN0(f) return(yylval.ival = f, REPORT("fun0",f) PL_expect = XOPERATOR,PL_bufptr = s,(int)FUNC0)
+#define FUN1(f) return(yylval.ival = f, REPORT("fun1",f) PL_expect = XOPERATOR,PL_bufptr = s,(int)FUNC1)
+#define BOop(f) return ao((yylval.ival=f, REPORT("bitorop",f) PL_expect = XTERM,PL_bufptr = s,(int)BITOROP))
+#define BAop(f) return ao((yylval.ival=f, REPORT("bitandop",f) PL_expect = XTERM,PL_bufptr = s,(int)BITANDOP))
+#define SHop(f) return ao((yylval.ival=f, REPORT("shiftop",f) PL_expect = XTERM,PL_bufptr = s,(int)SHIFTOP))
+#define PWop(f) return ao((yylval.ival=f, REPORT("powop",f) PL_expect = XTERM,PL_bufptr = s,(int)POWOP))
+#define PMop(f) return(yylval.ival=f, REPORT("matchop",f) PL_expect = XTERM,PL_bufptr = s,(int)MATCHOP)
+#define Aop(f) return ao((yylval.ival=f, REPORT("add",f) PL_expect = XTERM,PL_bufptr = s,(int)ADDOP))
+#define Mop(f) return ao((yylval.ival=f, REPORT("mul",f) PL_expect = XTERM,PL_bufptr = s,(int)MULOP))
+#define Eop(f) return(yylval.ival=f, REPORT("eq",f) PL_expect = XTERM,PL_bufptr = s,(int)EQOP)
+#define Rop(f) return(yylval.ival=f, REPORT("rel",f) PL_expect = XTERM,PL_bufptr = s,(int)RELOP)
 
 /* This bit of chicanery makes a unary function followed by
  * a parenthesis into a function with one argument, highest precedence.
  */
 #define UNI(f) return(yylval.ival = f, \
 
 /* This bit of chicanery makes a unary function followed by
  * a parenthesis into a function with one argument, highest precedence.
  */
 #define UNI(f) return(yylval.ival = f, \
+       REPORT("uni",f) \
        PL_expect = XTERM, \
        PL_bufptr = s, \
        PL_last_uni = PL_oldbufptr, \
        PL_expect = XTERM, \
        PL_bufptr = s, \
        PL_last_uni = PL_oldbufptr, \
@@ -164,6 +169,7 @@ int yyactlevel = 0;
        (*s == '(' || (s = skipspace(s), *s == '(') ? (int)FUNC1 : (int)UNIOP) )
 
 #define UNIBRACK(f) return(yylval.ival = f, \
        (*s == '(' || (s = skipspace(s), *s == '(') ? (int)FUNC1 : (int)UNIOP) )
 
 #define UNIBRACK(f) return(yylval.ival = f, \
+        REPORT("uni",f) \
        PL_bufptr = s, \
        PL_last_uni = PL_oldbufptr, \
        (*s == '(' || (s = skipspace(s), *s == '(') ? (int)FUNC1 : (int)UNIOP) )
        PL_bufptr = s, \
        PL_last_uni = PL_oldbufptr, \
        (*s == '(' || (s = skipspace(s), *s == '(') ? (int)FUNC1 : (int)UNIOP) )
@@ -171,6 +177,24 @@ int yyactlevel = 0;
 /* grandfather return to old style */
 #define OLDLOP(f) return(yylval.ival=f,PL_expect = XTERM,PL_bufptr = s,(int)LSTOP)
 
 /* grandfather return to old style */
 #define OLDLOP(f) return(yylval.ival=f,PL_expect = XTERM,PL_bufptr = s,(int)LSTOP)
 
+STATIC void
+S_tokereport(pTHX_ char *thing, char* s, I32 rv)
+{ 
+    SV *report;
+    DEBUG_T({
+        report = newSVpv(thing, 0);
+        Perl_sv_catpvf(aTHX_ report, ":line %i:%i:", CopLINE(PL_curcop), rv);
+
+        if (s - PL_bufptr > 0)
+            sv_catpvn(report, PL_bufptr, s - PL_bufptr);
+        else {
+            if (PL_oldbufptr && *PL_oldbufptr)
+                sv_catpv(report, PL_tokenbuf);
+        }
+        PerlIO_printf(Perl_debug_log, "### %s\n", SvPV_nolen(report));
+    })
+}
+
 /*
  * S_ao
  *
 /*
  * S_ao
  *
@@ -280,7 +304,6 @@ S_missingterm(pTHX_ char *s)
 void
 Perl_deprecate(pTHX_ char *s)
 {
 void
 Perl_deprecate(pTHX_ char *s)
 {
-    dTHR;
     if (ckWARN(WARN_DEPRECATED))
        Perl_warner(aTHX_ WARN_DEPRECATED, "Use of %s is deprecated", s);
 }
     if (ckWARN(WARN_DEPRECATED))
        Perl_warner(aTHX_ WARN_DEPRECATED, "Use of %s is deprecated", s);
 }
@@ -343,7 +366,6 @@ S_cr_textfilter(pTHX_ int idx, SV *sv, int maxlen)
 void
 Perl_lex_start(pTHX_ SV *line)
 {
 void
 Perl_lex_start(pTHX_ SV *line)
 {
-    dTHR;
     char *s;
     STRLEN len;
 
     char *s;
     STRLEN len;
 
@@ -367,6 +389,8 @@ Perl_lex_start(pTHX_ SV *line)
     SAVEPPTR(PL_bufend);
     SAVEPPTR(PL_oldbufptr);
     SAVEPPTR(PL_oldoldbufptr);
     SAVEPPTR(PL_bufend);
     SAVEPPTR(PL_oldbufptr);
     SAVEPPTR(PL_oldoldbufptr);
+    SAVEPPTR(PL_last_lop);
+    SAVEPPTR(PL_last_uni);
     SAVEPPTR(PL_linestart);
     SAVESPTR(PL_linestr);
     SAVEPPTR(PL_lex_brackstack);
     SAVEPPTR(PL_linestart);
     SAVESPTR(PL_linestr);
     SAVEPPTR(PL_lex_brackstack);
@@ -409,6 +433,7 @@ Perl_lex_start(pTHX_ SV *line)
     SvTEMP_off(PL_linestr);
     PL_oldoldbufptr = PL_oldbufptr = PL_bufptr = PL_linestart = SvPVX(PL_linestr);
     PL_bufend = PL_bufptr + SvCUR(PL_linestr);
     SvTEMP_off(PL_linestr);
     PL_oldoldbufptr = PL_oldbufptr = PL_bufptr = PL_linestart = SvPVX(PL_linestr);
     PL_bufend = PL_bufptr + SvCUR(PL_linestr);
+    PL_last_lop = PL_last_uni = Nullch;
     SvREFCNT_dec(PL_rs);
     PL_rs = newSVpvn("\n", 1);
     PL_rsfp = 0;
     SvREFCNT_dec(PL_rs);
     PL_rs = newSVpvn("\n", 1);
     PL_rsfp = 0;
@@ -439,7 +464,6 @@ Perl_lex_end(pTHX)
 STATIC void
 S_incline(pTHX_ char *s)
 {
 STATIC void
 S_incline(pTHX_ char *s)
 {
-    dTHR;
     char *t;
     char *n;
     char *e;
     char *t;
     char *n;
     char *e;
@@ -453,9 +477,9 @@ S_incline(pTHX_ char *s)
        s += 4;
     else
        return;
        s += 4;
     else
        return;
-    if (*s == ' ' || *s == '\t')
+    if (SPACE_OR_TAB(*s))
        s++;
        s++;
-    else 
+    else
        return;
     while (SPACE_OR_TAB(*s)) s++;
     if (!isDIGIT(*s))
        return;
     while (SPACE_OR_TAB(*s)) s++;
     if (!isDIGIT(*s))
@@ -501,7 +525,6 @@ S_incline(pTHX_ char *s)
 STATIC char *
 S_skipspace(pTHX_ register char *s)
 {
 STATIC char *
 S_skipspace(pTHX_ register char *s)
 {
-    dTHR;
     if (PL_lex_formbrack && PL_lex_brackets <= PL_lex_formbrack) {
        while (s < PL_bufend && SPACE_OR_TAB(*s))
            s++;
     if (PL_lex_formbrack && PL_lex_brackets <= PL_lex_formbrack) {
        while (s < PL_bufend && SPACE_OR_TAB(*s))
            s++;
@@ -556,6 +579,7 @@ S_skipspace(pTHX_ register char *s)
            PL_oldoldbufptr = PL_oldbufptr = PL_bufptr = s = PL_linestart
                = SvPVX(PL_linestr);
            PL_bufend = SvPVX(PL_linestr) + SvCUR(PL_linestr);
            PL_oldoldbufptr = PL_oldbufptr = PL_bufptr = s = PL_linestart
                = SvPVX(PL_linestr);
            PL_bufend = SvPVX(PL_linestr) + SvCUR(PL_linestr);
+           PL_last_lop = PL_last_uni = Nullch;
 
            /* Close the filehandle.  Could be from -P preprocessor,
             * STDIN, or a regular file.  If we were reading code from
 
            /* Close the filehandle.  Could be from -P preprocessor,
             * STDIN, or a regular file.  If we were reading code from
@@ -620,7 +644,6 @@ S_check_uni(pTHX)
 {
     char *s;
     char *t;
 {
     char *s;
     char *t;
-    dTHR;
 
     if (PL_oldoldbufptr != PL_last_uni)
        return;
 
     if (PL_oldoldbufptr != PL_last_uni)
        return;
@@ -632,8 +655,8 @@ S_check_uni(pTHX)
     if (ckWARN_d(WARN_AMBIGUOUS)){
         char ch = *s;
         *s = '\0';
     if (ckWARN_d(WARN_AMBIGUOUS)){
         char ch = *s;
         *s = '\0';
-        Perl_warner(aTHX_ WARN_AMBIGUOUS, 
-                  "Warning: Use of \"%s\" without parens is ambiguous", 
+        Perl_warner(aTHX_ WARN_AMBIGUOUS,
+                  "Warning: Use of \"%s\" without parens is ambiguous",
                   PL_last_uni);
         *s = ch;
     }
                   PL_last_uni);
         *s = ch;
     }
@@ -686,9 +709,9 @@ S_uni(pTHX_ I32 f, char *s)
 STATIC I32
 S_lop(pTHX_ I32 f, int x, char *s)
 {
 STATIC I32
 S_lop(pTHX_ I32 f, int x, char *s)
 {
-    dTHR;
     yylval.ival = f;
     CLINE;
     yylval.ival = f;
     CLINE;
+    REPORT("lop", f)
     PL_expect = x;
     PL_bufptr = s;
     PL_last_lop = PL_oldbufptr;
     PL_expect = x;
     PL_bufptr = s;
     PL_last_lop = PL_oldbufptr;
@@ -713,7 +736,7 @@ S_lop(pTHX_ I32 f, int x, char *s)
  * handles the token correctly.
  */
 
  * handles the token correctly.
  */
 
-STATIC void 
+STATIC void
 S_force_next(pTHX_ I32 type)
 {
     PL_nexttype[PL_nexttoke] = type;
 S_force_next(pTHX_ I32 type)
 {
     PL_nexttype[PL_nexttoke] = type;
@@ -746,7 +769,7 @@ S_force_word(pTHX_ register char *start, int token, int check_keyword, int allow
 {
     register char *s;
     STRLEN len;
 {
     register char *s;
     STRLEN len;
-    
+
     start = skipspace(start);
     s = start;
     if (isIDFIRST_lazy_if(s,UTF) ||
     start = skipspace(start);
     s = start;
     if (isIDFIRST_lazy_if(s,UTF) ||
@@ -788,7 +811,6 @@ S_force_ident(pTHX_ register char *s, int kind)
        PL_nextval[PL_nexttoke].opval = o;
        force_next(WORD);
        if (kind) {
        PL_nextval[PL_nexttoke].opval = o;
        force_next(WORD);
        if (kind) {
-           dTHR;               /* just for in_eval */
            o->op_private = OPpCONST_ENTERED;
            /* XXX see note in pp_entereval() for why we forgo typo
               warnings if the symbol must be introduced in an eval.
            o->op_private = OPpCONST_ENTERED;
            /* XXX see note in pp_entereval() for why we forgo typo
               warnings if the symbol must be introduced in an eval.
@@ -828,7 +850,7 @@ Perl_str_to_version(pTHX_ SV *sv)
     return retval;
 }
 
     return retval;
 }
 
-/* 
+/*
  * S_force_version
  * Forces the next token to be a version number.
  */
  * S_force_version
  * Forces the next token to be a version number.
  */
@@ -861,7 +883,7 @@ S_force_version(pTHX_ char *s)
 
     /* NOTE: The parser sees the package name and the VERSION swapped */
     PL_nextval[PL_nexttoke].opval = version;
 
     /* NOTE: The parser sees the package name and the VERSION swapped */
     PL_nextval[PL_nexttoke].opval = version;
-    force_next(WORD); 
+    force_next(WORD);
 
     return (s);
 }
 
     return (s);
 }
@@ -969,7 +991,7 @@ S_sublex_start(pTHX)
                SvUTF8_on(nsv);
            SvREFCNT_dec(sv);
            sv = nsv;
                SvUTF8_on(nsv);
            SvREFCNT_dec(sv);
            sv = nsv;
-       } 
+       }
        yylval.opval = (OP*)newSVOP(op_type, 0, sv);
        PL_lex_stuff = Nullsv;
        return THING;
        yylval.opval = (OP*)newSVOP(op_type, 0, sv);
        PL_lex_stuff = Nullsv;
        return THING;
@@ -1001,7 +1023,6 @@ S_sublex_start(pTHX)
 STATIC I32
 S_sublex_push(pTHX)
 {
 STATIC I32
 S_sublex_push(pTHX)
 {
-    dTHR;
     ENTER;
 
     PL_lex_state = PL_sublex_info.super_state;
     ENTER;
 
     PL_lex_state = PL_sublex_info.super_state;
@@ -1016,6 +1037,8 @@ S_sublex_push(pTHX)
     SAVEPPTR(PL_bufptr);
     SAVEPPTR(PL_oldbufptr);
     SAVEPPTR(PL_oldoldbufptr);
     SAVEPPTR(PL_bufptr);
     SAVEPPTR(PL_oldbufptr);
     SAVEPPTR(PL_oldoldbufptr);
+    SAVEPPTR(PL_last_lop);
+    SAVEPPTR(PL_last_uni);
     SAVEPPTR(PL_linestart);
     SAVESPTR(PL_linestr);
     SAVEPPTR(PL_lex_brackstack);
     SAVEPPTR(PL_linestart);
     SAVESPTR(PL_linestr);
     SAVEPPTR(PL_lex_brackstack);
@@ -1027,6 +1050,7 @@ S_sublex_push(pTHX)
     PL_bufend = PL_bufptr = PL_oldbufptr = PL_oldoldbufptr = PL_linestart
        = SvPVX(PL_linestr);
     PL_bufend += SvCUR(PL_linestr);
     PL_bufend = PL_bufptr = PL_oldbufptr = PL_oldoldbufptr = PL_linestart
        = SvPVX(PL_linestr);
     PL_bufend += SvCUR(PL_linestr);
+    PL_last_lop = PL_last_uni = Nullch;
     SAVEFREESV(PL_linestr);
 
     PL_lex_dojoin = FALSE;
     SAVEFREESV(PL_linestr);
 
     PL_lex_dojoin = FALSE;
@@ -1059,8 +1083,11 @@ STATIC I32
 S_sublex_done(pTHX)
 {
     if (!PL_lex_starts++) {
 S_sublex_done(pTHX)
 {
     if (!PL_lex_starts++) {
+       SV *sv = newSVpvn("",0);
+       if (SvUTF8(PL_linestr))
+           SvUTF8_on(sv);
        PL_expect = XOPERATOR;
        PL_expect = XOPERATOR;
-       yylval.opval = (OP*)newSVOP(OP_CONST, 0, newSVpvn("",0));
+       yylval.opval = (OP*)newSVOP(OP_CONST, 0, sv);
        return THING;
     }
 
        return THING;
     }
 
@@ -1075,6 +1102,7 @@ S_sublex_done(pTHX)
        PL_lex_inpat = 0;
        PL_bufend = PL_bufptr = PL_oldbufptr = PL_oldoldbufptr = PL_linestart = SvPVX(PL_linestr);
        PL_bufend += SvCUR(PL_linestr);
        PL_lex_inpat = 0;
        PL_bufend = PL_bufptr = PL_oldbufptr = PL_oldoldbufptr = PL_linestart = SvPVX(PL_linestr);
        PL_bufend += SvCUR(PL_linestr);
+       PL_last_lop = PL_last_uni = Nullch;
        SAVEFREESV(PL_linestr);
        PL_lex_dojoin = FALSE;
        PL_lex_brackets = 0;
        SAVEFREESV(PL_linestr);
        PL_lex_dojoin = FALSE;
        PL_lex_brackets = 0;
@@ -1175,7 +1203,7 @@ S_sublex_done(pTHX)
              } (end switch)
          } (end if backslash)
     } (end while character to read)
              } (end switch)
          } (end if backslash)
     } (end while character to read)
-                 
+               
 */
 
 STATIC char *
 */
 
 STATIC char *
@@ -1187,7 +1215,8 @@ S_scan_const(pTHX_ char *start)
     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? */
     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? */
-    bool has_utf8 = FALSE;                     /* embedded \x{} */
+    bool has_utf8 = (PL_linestr && SvUTF8(PL_linestr));
+                                               /* the constant is UTF8 */
     UV uv;
 
     I32 utf = (PL_lex_inwhat == OP_TRANS && PL_sublex_info.sub_op)
     UV uv;
 
     I32 utf = (PL_lex_inwhat == OP_TRANS && PL_sublex_info.sub_op)
@@ -1211,6 +1240,17 @@ S_scan_const(pTHX_ char *start)
                I32 min;                        /* first character in range */
                I32 max;                        /* last character in range */
 
                I32 min;                        /* first character in range */
                I32 max;                        /* last character in range */
 
+               if (utf) {
+                   char *c = (char*)utf8_hop((U8*)d, -1);
+                   char *e = d++;
+                   while (e-- > c)
+                       *(e + 1) = *e;
+                   *c = (char)0xff;
+                   /* mark the range as done, and continue */
+                   dorange = FALSE;
+                   didrange = TRUE;
+                   continue;
+               }
                i = d - SvPVX(sv);              /* remember current offset */
                SvGROW(sv, SvLEN(sv) + 256);    /* never more than 256 chars in a range */
                d = SvPVX(sv) + i;              /* refresh d after realloc */
                i = d - SvPVX(sv);              /* remember current offset */
                SvGROW(sv, SvLEN(sv) + 256);    /* never more than 256 chars in a range */
                d = SvPVX(sv) + i;              /* refresh d after realloc */
@@ -1247,11 +1287,11 @@ S_scan_const(pTHX_ char *start)
                dorange = FALSE;
                didrange = TRUE;
                continue;
                dorange = FALSE;
                didrange = TRUE;
                continue;
-           } 
+           }
 
            /* range begins (ignore - as first or last char) */
            else if (*s == '-' && s+1 < send  && s != start) {
 
            /* range begins (ignore - as first or last char) */
            else if (*s == '-' && s+1 < send  && s != start) {
-               if (didrange) { 
+               if (didrange) {
                    Perl_croak(aTHX_ "Ambiguous range in transliteration operator");
                }
                if (utf) {
                    Perl_croak(aTHX_ "Ambiguous range in transliteration operator");
                }
                if (utf) {
@@ -1286,9 +1326,9 @@ S_scan_const(pTHX_ char *start)
                while (count && (c = *regparse)) {
                    if (c == '\\' && regparse[1])
                        regparse++;
                while (count && (c = *regparse)) {
                    if (c == '\\' && regparse[1])
                        regparse++;
-                   else if (c == '{') 
+                   else if (c == '{')
                        count++;
                        count++;
-                   else if (c == '}') 
+                   else if (c == '}')
                        count--;
                    regparse++;
                }
                        count--;
                    regparse++;
                }
@@ -1325,28 +1365,6 @@ S_scan_const(pTHX_ char *start)
                break;          /* in regexp, $ might be tail anchor */
        }
 
                break;          /* in regexp, $ might be tail anchor */
        }
 
-       /* (now in tr/// code again) */
-
-       if (*s & 0x80 && this_utf8) {
-           STRLEN len;
-           UV uv;
-
-           uv = utf8_to_uv((U8*)s, send - s, &len, UTF8_CHECK_ONLY);
-           if (len == (STRLEN)-1) {
-               /* Illegal UTF8 (a high-bit byte), make it valid. */
-               char *old_pvx = SvPVX(sv);
-               /* need space for one extra char (NOTE: SvCUR() not set here) */
-               d = SvGROW(sv, SvLEN(sv) + 1) + (d - old_pvx);
-               d = (char*)uv_to_utf8((U8*)d, (U8)*s++);
-           }
-           else {
-               while (len--)
-                   *d++ = *s++;
-           }
-           has_utf8 = TRUE;
-           continue;
-       }
-
        /* backslashes */
        if (*s == '\\' && s+1 < send) {
            s++;
        /* backslashes */
        if (*s == '\\' && s+1 < send) {
            s++;
@@ -1362,7 +1380,6 @@ S_scan_const(pTHX_ char *start)
            if (PL_lex_inwhat == OP_SUBST && !PL_lex_inpat &&
                isDIGIT(*s) && *s != '0' && !isDIGIT(s[1]))
            {
            if (PL_lex_inwhat == OP_SUBST && !PL_lex_inpat &&
                isDIGIT(*s) && *s != '0' && !isDIGIT(s[1]))
            {
-               dTHR;                   /* only for ckWARN */
                if (ckWARN(WARN_SYNTAX))
                    Perl_warner(aTHX_ WARN_SYNTAX, "\\%c better written as $%c", *s, *s);
                *--s = '$';
                if (ckWARN(WARN_SYNTAX))
                    Perl_warner(aTHX_ WARN_SYNTAX, "\\%c better written as $%c", *s, *s);
                *--s = '$';
@@ -1387,14 +1404,12 @@ S_scan_const(pTHX_ char *start)
                /* FALL THROUGH */
            default:
                {
                /* FALL THROUGH */
            default:
                {
-                   dTHR;
                    if (ckWARN(WARN_MISC) && isALNUM(*s))
                    if (ckWARN(WARN_MISC) && isALNUM(*s))
-                       Perl_warner(aTHX_ WARN_MISC, 
+                       Perl_warner(aTHX_ WARN_MISC,
                               "Unrecognized escape \\%c passed through",
                               *s);
                    /* default action is to copy the quoted character */
                               "Unrecognized escape \\%c passed through",
                               *s);
                    /* default action is to copy the quoted character */
-                   *d++ = *s++;
-                   continue;
+                   goto default_action;
                }
 
            /* \132 indicates an octal constant */
                }
 
            /* \132 indicates an octal constant */
@@ -1419,7 +1434,6 @@ S_scan_const(pTHX_ char *start)
                    else {
                        STRLEN len = 1;         /* allow underscores */
                        uv = (UV)scan_hex(s + 1, e - s - 1, &len);
                    else {
                        STRLEN len = 1;         /* allow underscores */
                        uv = (UV)scan_hex(s + 1, e - s - 1, &len);
-                       has_utf8 = TRUE;
                    }
                    s = e + 1;
                }
                    }
                    s = e + 1;
                }
@@ -1433,34 +1447,47 @@ S_scan_const(pTHX_ char *start)
 
              NUM_ESCAPE_INSERT:
                /* Insert oct or hex escaped character.
 
              NUM_ESCAPE_INSERT:
                /* Insert oct or hex escaped character.
-                * There will always enough room in sv since such escapes will
-                * be longer than any utf8 sequence they can end up as
-                */
-               if (uv > 127 || has_utf8) {
-                   if (!this_utf8 && !has_utf8 && uv > 255) {
-                       /* might need to recode whatever we have accumulated so far
-                        * if it contains any hibit chars
+                * There will always enough room in sv since such
+                * escapes will be longer than any UT-F8 sequence
+                * they can end up as. */
+
+               /* This spot is wrong for EBCDIC.  Characters like
+                * the lowercase letters and digits are >127 in EBCDIC,
+                * so here they would need to be mapped to the Unicode
+                * repertoire.   --jhi */
+               
+               if (uv > 127) {
+                   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;
                        char *c;
                         */
                        int hicount = 0;
                        char *c;
+
                        for (c = SvPVX(sv); c < d; c++) {
                        for (c = SvPVX(sv); c < d; c++) {
-                           if (*c & 0x80)
+                           if (UTF8_IS_CONTINUED(*c))
                                hicount++;
                        }
                        if (hicount) {
                            char *old_pvx = SvPVX(sv);
                            char *src, *dst;
                                hicount++;
                        }
                        if (hicount) {
                            char *old_pvx = SvPVX(sv);
                            char *src, *dst;
-                           d = SvGROW(sv, SvCUR(sv) + hicount + 1) + (d - old_pvx);
+                         
+                           d = SvGROW(sv,
+                                      SvLEN(sv) + hicount + 1) +
+                                        (d - old_pvx);
 
                            src = d - 1;
                            d += hicount;
                            dst = d - 1;
 
                            while (src < dst) {
 
                            src = d - 1;
                            d += hicount;
                            dst = d - 1;
 
                            while (src < dst) {
-                               if (*src & 0x80) {
-                                   dst--;
-                                   uv_to_utf8((U8*)dst, (U8)*src--);
-                                   dst--;
+                               if (UTF8_IS_CONTINUED(*src)) {
+                                   *dst-- = UTF8_EIGHT_BIT_LO(*src);
+                                   *dst-- = UTF8_EIGHT_BIT_HI(*src--);
                                }
                                else {
                                    *dst-- = *src--;
                                }
                                else {
                                    *dst-- = *src--;
@@ -1471,7 +1498,14 @@ S_scan_const(pTHX_ char *start)
 
                     if (has_utf8 || uv > 255) {
                        d = (char*)uv_to_utf8((U8*)d, uv);
 
                     if (has_utf8 || uv > 255) {
                        d = (char*)uv_to_utf8((U8*)d, uv);
-                       this_utf8 = TRUE;
+                       has_utf8 = TRUE;
+                       if (PL_lex_inwhat == OP_TRANS &&
+                           PL_sublex_info.sub_op) {
+                           PL_sublex_info.sub_op->op_private |=
+                               (PL_lex_repl ? OPpTRANS_FROM_UTF
+                                            : OPpTRANS_TO_UTF);
+                           utf = TRUE;
+                       }
                     }
                    else {
                        *d++ = (char)uv;
                     }
                    else {
                        *d++ = (char)uv;
@@ -1490,15 +1524,17 @@ S_scan_const(pTHX_ char *start)
                    SV *res;
                    STRLEN len;
                    char *str;
                    SV *res;
                    STRLEN len;
                    char *str;
- 
+
                    if (!e) {
                        yyerror("Missing right brace on \\N{}");
                        e = s - 1;
                        goto cont_scan;
                    }
                    res = newSVpvn(s + 1, e - s - 1);
                    if (!e) {
                        yyerror("Missing right brace on \\N{}");
                        e = s - 1;
                        goto cont_scan;
                    }
                    res = newSVpvn(s + 1, e - s - 1);
-                   res = new_constant( Nullch, 0, "charnames", 
+                   res = new_constant( Nullch, 0, "charnames",
                                        res, Nullsv, "\\N{...}" );
                                        res, Nullsv, "\\N{...}" );
+                   if (has_utf8)
+                       sv_utf8_upgrade(res);
                    str = SvPV(res,len);
                    if (!has_utf8 && SvUTF8(res)) {
                        char *ostart = SvPVX(sv);
                    str = SvPV(res,len);
                    if (!has_utf8 && SvUTF8(res)) {
                        char *ostart = SvPVX(sv);
@@ -1514,7 +1550,7 @@ S_scan_const(pTHX_ char *start)
                    if (len > e - s + 4) {
                        char *odest = SvPVX(sv);
 
                    if (len > e - s + 4) {
                        char *odest = SvPVX(sv);
 
-                       SvGROW(sv, (SvCUR(sv) + len - (e - s + 4)));
+                       SvGROW(sv, (SvLEN(sv) + len - (e - s + 4)));
                        d = SvPVX(sv) + (d - odest);
                    }
                    Copy(str, d, len, char);
                        d = SvPVX(sv) + (d - odest);
                    }
                    Copy(str, d, len, char);
@@ -1534,7 +1570,7 @@ S_scan_const(pTHX_ char *start)
                *d = *s++;
                if (isLOWER(*d))
                   *d = toUPPER(*d);
                *d = *s++;
                if (isLOWER(*d))
                   *d = toUPPER(*d);
-               *d = toCTRL(*d); 
+               *d = toCTRL(*d);
                d++;
 #else
                {
                d++;
 #else
                {
@@ -1581,7 +1617,34 @@ S_scan_const(pTHX_ char *start)
            continue;
        } /* end if (backslash) */
 
            continue;
        } /* end if (backslash) */
 
-       *d++ = *s++;
+    default_action:
+       if (UTF8_IS_CONTINUED(*s) && (this_utf8 || has_utf8)) {
+           STRLEN len = (STRLEN) -1;
+           UV uv;
+           if (this_utf8) {
+               uv = utf8_to_uv((U8*)s, send - s, &len, 0);
+           }
+           if (len == (STRLEN)-1) {
+               /* Illegal UTF8 (a high-bit byte), make it valid. */
+               char *old_pvx = SvPVX(sv);
+               /* need space for one extra char (NOTE: SvCUR() not set here) */
+               d = SvGROW(sv, SvLEN(sv) + 1) + (d - old_pvx);
+               d = (char*)uv_to_utf8((U8*)d, (U8)*s++);
+           }
+           else {
+               while (len--)
+                   *d++ = *s++;
+           }
+           has_utf8 = TRUE;
+          if (PL_lex_inwhat == OP_TRANS && PL_sublex_info.sub_op) {
+              PL_sublex_info.sub_op->op_private |=
+                  (PL_lex_repl ? OPpTRANS_FROM_UTF : OPpTRANS_TO_UTF);
+              utf = TRUE;
+          }
+           continue;
+       }
+
+       *d++ = *s++;
     } /* while loop to process each character */
 
     /* terminate the string and set up the sv */
     } /* while loop to process each character */
 
     /* terminate the string and set up the sv */
@@ -1600,9 +1663,9 @@ S_scan_const(pTHX_ char *start)
     /* return the substring (via yylval) only if we parsed anything */
     if (s > PL_bufptr) {
        if ( PL_hints & ( PL_lex_inpat ? HINT_NEW_RE : HINT_NEW_STRING ) )
     /* return the substring (via yylval) only if we parsed anything */
     if (s > PL_bufptr) {
        if ( PL_hints & ( PL_lex_inpat ? HINT_NEW_RE : HINT_NEW_STRING ) )
-           sv = new_constant(start, s - start, (PL_lex_inpat ? "qr" : "q"), 
+           sv = new_constant(start, s - start, (PL_lex_inpat ? "qr" : "q"),
                              sv, Nullsv,
                              sv, Nullsv,
-                             ( PL_lex_inwhat == OP_TRANS 
+                             ( PL_lex_inwhat == OP_TRANS
                                ? "tr"
                                : ( (PL_lex_inwhat == OP_SUBST && !PL_lex_inpat)
                                    ? "s"
                                ? "tr"
                                : ( (PL_lex_inwhat == OP_SUBST && !PL_lex_inpat)
                                    ? "s"
@@ -1873,7 +1936,7 @@ S_incl_perldb(pTHX)
 
 
 /* Encoded script support. filter_add() effectively inserts a
 
 
 /* Encoded script support. filter_add() effectively inserts a
- * 'pre-processing' function into the current source input stream. 
+ * 'pre-processing' function into the current source input stream.
  * Note that the filter function only applies to the current source file
  * (e.g., it will not affect files 'require'd or 'use'd by this one).
  *
  * Note that the filter function only applies to the current source file
  * (e.g., it will not affect files 'require'd or 'use'd by this one).
  *
@@ -1909,7 +1972,7 @@ Perl_filter_add(pTHX_ filter_t funcp, SV *datasv)
     av_store(PL_rsfp_filters, 0, datasv) ;
     return(datasv);
 }
     av_store(PL_rsfp_filters, 0, datasv) ;
     return(datasv);
 }
- 
+
 
 /* Delete most recently added instance of this filter function.        */
 void
 
 /* Delete most recently added instance of this filter function.        */
 void
@@ -1936,8 +1999,8 @@ Perl_filter_del(pTHX_ filter_t funcp)
 /* Invoke the n'th filter function for the current rsfp.        */
 I32
 Perl_filter_read(pTHX_ int idx, SV *buf_sv, int maxlen)
 /* Invoke the n'th filter function for the current rsfp.        */
 I32
 Perl_filter_read(pTHX_ int idx, SV *buf_sv, int maxlen)
-            
-               
+
+
                                /* 0 = read one text line */
 {
     filter_t funcp;
                                /* 0 = read one text line */
 {
     filter_t funcp;
@@ -1950,7 +2013,7 @@ Perl_filter_read(pTHX_ int idx, SV *buf_sv, int maxlen)
        /* Note that we append to the line. This is handy.      */
        DEBUG_P(PerlIO_printf(Perl_debug_log,
                              "filter_read %d: from rsfp\n", idx));
        /* Note that we append to the line. This is handy.      */
        DEBUG_P(PerlIO_printf(Perl_debug_log,
                              "filter_read %d: from rsfp\n", idx));
-       if (maxlen) { 
+       if (maxlen) {
            /* Want a block */
            int len ;
            int old_len = SvCUR(buf_sv) ;
            /* Want a block */
            int len ;
            int old_len = SvCUR(buf_sv) ;
@@ -2073,24 +2136,21 @@ S_find_in_my_stash(pTHX_ char *pkgname, I32 len)
 */
 
 #ifdef USE_PURE_BISON
 */
 
 #ifdef USE_PURE_BISON
-#ifdef __SC__
-#pragma segment Perl_yylex_r
-#endif
 int
 Perl_yylex_r(pTHX_ YYSTYPE *lvalp, int *lcharp)
 {
 int
 Perl_yylex_r(pTHX_ YYSTYPE *lvalp, int *lcharp)
 {
-    dTHR;
     int r;
 
     int r;
 
+    yyactlevel++;
     yylval_pointer[yyactlevel] = lvalp;
     yychar_pointer[yyactlevel] = lcharp;
     yylval_pointer[yyactlevel] = lvalp;
     yychar_pointer[yyactlevel] = lcharp;
-    yyactlevel++;
     if (yyactlevel >= YYMAXLEVEL)
        Perl_croak(aTHX_ "panic: YYMAXLEVEL");
 
     r = Perl_yylex(aTHX);
 
     if (yyactlevel >= YYMAXLEVEL)
        Perl_croak(aTHX_ "panic: YYMAXLEVEL");
 
     r = Perl_yylex(aTHX);
 
-    yyactlevel--;
+    if (yyactlevel > 0)
+       yyactlevel--;
 
     return r;
 }
 
     return r;
 }
@@ -2099,21 +2159,16 @@ Perl_yylex_r(pTHX_ YYSTYPE *lvalp, int *lcharp)
 #ifdef __SC__
 #pragma segment Perl_yylex
 #endif
 #ifdef __SC__
 #pragma segment Perl_yylex
 #endif
-
 int
 int
-#ifdef USE_PURE_BISON
-Perl_yylex(pTHX_ YYSTYPE *lvalp, int *lcharp)
-#else
 Perl_yylex(pTHX)
 Perl_yylex(pTHX)
-#endif
 {
 {
-    dTHR;
     register char *s;
     register char *d;
     register I32 tmp;
     STRLEN len;
     GV *gv = Nullgv;
     GV **gvp = 0;
     register char *s;
     register char *d;
     register I32 tmp;
     STRLEN len;
     GV *gv = Nullgv;
     GV **gvp = 0;
+    bool bof = FALSE;
 
     /* check if there's an identifier for us to look at */
     if (PL_pending_ident) {
 
     /* check if there's an identifier for us to look at */
     if (PL_pending_ident) {
@@ -2121,6 +2176,9 @@ Perl_yylex(pTHX)
        char pit = PL_pending_ident;
        PL_pending_ident = 0;
 
        char pit = PL_pending_ident;
        PL_pending_ident = 0;
 
+       DEBUG_T({ PerlIO_printf(Perl_debug_log,
+              "### Tokener saw identifier '%s'\n", PL_tokenbuf); })
+
        /* if we're in a my(), we can't allow dynamics here.
           $foo'bar has already been turned into $foo::bar, so
           just check for colons.
        /* if we're in a my(), we can't allow dynamics here.
           $foo'bar has already been turned into $foo::bar, so
           just check for colons.
@@ -2145,7 +2203,7 @@ Perl_yylex(pTHX)
            }
        }
 
            }
        }
 
-       /* 
+       /*
           build the ops for accesses to a my() variable.
 
           Deny my($a) or my($b) in a sort block, *if* $a or $b is
           build the ops for accesses to a my() variable.
 
           Deny my($a) or my($b) in a sort block, *if* $a or $b is
@@ -2258,6 +2316,10 @@ Perl_yylex(pTHX)
            PL_expect = PL_lex_expect;
            PL_lex_defer = LEX_NORMAL;
        }
            PL_expect = PL_lex_expect;
            PL_lex_defer = LEX_NORMAL;
        }
+       DEBUG_T({ PerlIO_printf(Perl_debug_log,
+              "### Next token after '%s' was known, type %"IVdf"\n", PL_bufptr,
+              (IV)PL_nexttype[PL_nexttoke]); })
+
        return(PL_nexttype[PL_nexttoke]);
 
     /* interpolated case modifiers like \L \U, including \Q and \E.
        return(PL_nexttype[PL_nexttoke]);
 
     /* interpolated case modifiers like \L \U, including \Q and \E.
@@ -2289,6 +2351,8 @@ Perl_yylex(pTHX)
            return yylex();
        }
        else {
            return yylex();
        }
        else {
+           DEBUG_T({ PerlIO_printf(Perl_debug_log,
+              "### Saw case modifier at '%s'\n", PL_bufptr); })
            s = PL_bufptr + 1;
            if (strnEQ(s, "L\\u", 3) || strnEQ(s, "U\\l", 3))
                tmp = *s, *s = s[2], s[2] = tmp;        /* misordered... */
            s = PL_bufptr + 1;
            if (strnEQ(s, "L\\u", 3) || strnEQ(s, "U\\l", 3))
                tmp = *s, *s = s[2], s[2] = tmp;        /* misordered... */
@@ -2339,6 +2403,8 @@ Perl_yylex(pTHX)
     case LEX_INTERPSTART:
        if (PL_bufptr == PL_bufend)
            return sublex_done();
     case LEX_INTERPSTART:
        if (PL_bufptr == PL_bufend)
            return sublex_done();
+       DEBUG_T({ PerlIO_printf(Perl_debug_log,
+              "### Interpolated variable at '%s'\n", PL_bufptr); })
        PL_expect = XTERM;
        PL_lex_dojoin = (*PL_bufptr == '@');
        PL_lex_state = LEX_INTERPNORMAL;
        PL_expect = XTERM;
        PL_lex_dojoin = (*PL_bufptr == '@');
        PL_lex_state = LEX_INTERPNORMAL;
@@ -2435,7 +2501,7 @@ Perl_yylex(pTHX)
     s = PL_bufptr;
     PL_oldoldbufptr = PL_oldbufptr;
     PL_oldbufptr = s;
     s = PL_bufptr;
     PL_oldoldbufptr = PL_oldbufptr;
     PL_oldbufptr = s;
-    DEBUG_p( {
+    DEBUG_T( {
        PerlIO_printf(Perl_debug_log, "### Tokener expecting %s at %s\n",
                      exp_name[PL_expect], s);
     } )
        PerlIO_printf(Perl_debug_log, "### Tokener expecting %s at %s\n",
                      exp_name[PL_expect], s);
     } )
@@ -2455,6 +2521,9 @@ Perl_yylex(pTHX)
            PL_last_lop = 0;
            if (PL_lex_brackets)
                yyerror("Missing right curly or square bracket");
            PL_last_lop = 0;
            if (PL_lex_brackets)
                yyerror("Missing right curly or square bracket");
+            DEBUG_T( { PerlIO_printf(Perl_debug_log,
+                        "### Tokener got EOF\n");
+            } )
            TOKEN(0);
        }
        if (s++ < PL_bufend)
            TOKEN(0);
        }
        if (s++ < PL_bufend)
@@ -2510,6 +2579,7 @@ Perl_yylex(pTHX)
            sv_catpv(PL_linestr, "\n");
            PL_oldoldbufptr = PL_oldbufptr = s = PL_linestart = SvPVX(PL_linestr);
            PL_bufend = SvPVX(PL_linestr) + SvCUR(PL_linestr);
            sv_catpv(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 = Nullch;
            if (PERLDB_LINE && PL_curstash != PL_debstash) {
                SV *sv = NEWSV(85,0);
 
            if (PERLDB_LINE && PL_curstash != PL_debstash) {
                SV *sv = NEWSV(85,0);
 
@@ -2520,8 +2590,35 @@ Perl_yylex(pTHX)
            goto retry;
        }
        do {
            goto retry;
        }
        do {
-           bool bof = PL_rsfp ? TRUE : FALSE;
-           if (bof) {
+           bof = PL_rsfp ? TRUE : FALSE;
+           if ((s = filter_gets(PL_linestr, PL_rsfp, 0)) == Nullch) {
+             fake_eof:
+               if (PL_rsfp) {
+                   if (PL_preprocess && !PL_in_eval)
+                       (void)PerlProc_pclose(PL_rsfp);
+                   else if ((PerlIO *)PL_rsfp == PerlIO_stdin())
+                       PerlIO_clearerr(PL_rsfp);
+                   else
+                       (void)PerlIO_close(PL_rsfp);
+                   PL_rsfp = Nullfp;
+                   PL_doextract = FALSE;
+               }
+               if (!PL_in_eval && (PL_minus_n || PL_minus_p)) {
+                   sv_setpv(PL_linestr,PL_minus_p ? ";}continue{print" : "");
+                   sv_catpv(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 = Nullch;
+                   PL_minus_n = PL_minus_p = 0;
+                   goto retry;
+               }
+               PL_oldoldbufptr = PL_oldbufptr = s = PL_linestart = SvPVX(PL_linestr);
+               PL_last_lop = PL_last_uni = Nullch;
+               sv_setpv(PL_linestr,"");
+               TOKEN(';');     /* not infinite loop because rsfp is NULL now */
+           }
+           /* if it looks like the start of a BOM, check if it in fact is */
+           else if (bof && (!*s || *(U8*)s == 0xEF || *(U8*)s >= 0xFE)) {
 #ifdef PERLIO_IS_STDIO
 #  ifdef __GNU_LIBRARY__
 #    if __GNU_LIBRARY__ == 1 /* Linux glibc5 */
 #ifdef PERLIO_IS_STDIO
 #  ifdef __GNU_LIBRARY__
 #    if __GNU_LIBRARY__ == 1 /* Linux glibc5 */
@@ -2541,38 +2638,14 @@ Perl_yylex(pTHX)
                 * Workaround?  Maybe attach some extra state to PL_rsfp?
                 */
                if (!PL_preprocess)
                 * Workaround?  Maybe attach some extra state to PL_rsfp?
                 */
                if (!PL_preprocess)
-                   bof = PerlIO_tell(PL_rsfp) == 0;
+                   bof = PerlIO_tell(PL_rsfp) == SvCUR(PL_linestr);
 #else
 #else
-               bof = PerlIO_tell(PL_rsfp) == 0;
+               bof = PerlIO_tell(PL_rsfp) == SvCUR(PL_linestr);
 #endif
 #endif
-           }
-           s = filter_gets(PL_linestr, PL_rsfp, 0);
-           if (s == Nullch) {
-             fake_eof:
-               if (PL_rsfp) {
-                   if (PL_preprocess && !PL_in_eval)
-                       (void)PerlProc_pclose(PL_rsfp);
-                   else if ((PerlIO *)PL_rsfp == PerlIO_stdin())
-                       PerlIO_clearerr(PL_rsfp);
-                   else
-                       (void)PerlIO_close(PL_rsfp);
-                   PL_rsfp = Nullfp;
-                   PL_doextract = FALSE;
-               }
-               if (!PL_in_eval && (PL_minus_n || PL_minus_p)) {
-                   sv_setpv(PL_linestr,PL_minus_p ? ";}continue{print" : "");
-                   sv_catpv(PL_linestr,";}");
-                   PL_oldoldbufptr = PL_oldbufptr = s = PL_linestart = SvPVX(PL_linestr);
+               if (bof) {
                    PL_bufend = SvPVX(PL_linestr) + SvCUR(PL_linestr);
                    PL_bufend = SvPVX(PL_linestr) + SvCUR(PL_linestr);
-                   PL_minus_n = PL_minus_p = 0;
-                   goto retry;
+                   s = swallow_bom((U8*)s);
                }
                }
-               PL_oldoldbufptr = PL_oldbufptr = s = PL_linestart = SvPVX(PL_linestr);
-               sv_setpv(PL_linestr,"");
-               TOKEN(';');     /* not infinite loop because rsfp is NULL now */
-           } else if (bof) {
-               PL_bufend = SvPVX(PL_linestr) + SvCUR(PL_linestr);
-               s = swallow_bom((U8*)s);
            }
            if (PL_doextract) {
                if (*s == '#' && s[1] == '!' && instr(s,"perl"))
            }
            if (PL_doextract) {
                if (*s == '#' && s[1] == '!' && instr(s,"perl"))
@@ -2583,9 +2656,10 @@ Perl_yylex(pTHX)
                    sv_setpv(PL_linestr, "");
                    PL_oldoldbufptr = PL_oldbufptr = s = PL_linestart = SvPVX(PL_linestr);
                    PL_bufend = SvPVX(PL_linestr) + SvCUR(PL_linestr);
                    sv_setpv(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 = Nullch;
                    PL_doextract = FALSE;
                }
                    PL_doextract = FALSE;
                }
-           } 
+           }
            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;
@@ -2597,6 +2671,7 @@ Perl_yylex(pTHX)
            av_store(CopFILEAV(PL_curcop),(I32)CopLINE(PL_curcop),sv);
        }
        PL_bufend = SvPVX(PL_linestr) + SvCUR(PL_linestr);
            av_store(CopFILEAV(PL_curcop),(I32)CopLINE(PL_curcop),sv);
        }
        PL_bufend = SvPVX(PL_linestr) + SvCUR(PL_linestr);
+       PL_last_lop = PL_last_uni = Nullch;
        if (CopLINE(PL_curcop) == 1) {
            while (s < PL_bufend && isSPACE(*s))
                s++;
        if (CopLINE(PL_curcop) == 1) {
            while (s < PL_bufend && isSPACE(*s))
                s++;
@@ -2710,7 +2785,7 @@ Perl_yylex(pTHX)
                    else
                        newargv = PL_origargv;
                    newargv[0] = ipath;
                    else
                        newargv = PL_origargv;
                    newargv[0] = ipath;
-                   PerlProc_execv(ipath, newargv);
+                   PerlProc_execv(ipath, EXEC_ARGV_CAST(newargv));
                    Perl_croak(aTHX_ "Can't exec %s", ipath);
                }
 #endif
                    Perl_croak(aTHX_ "Can't exec %s", ipath);
                }
 #endif
@@ -2740,6 +2815,7 @@ Perl_yylex(pTHX)
                            sv_setpv(PL_linestr, "");
                            PL_oldoldbufptr = PL_oldbufptr = s = PL_linestart = SvPVX(PL_linestr);
                            PL_bufend = SvPVX(PL_linestr) + SvCUR(PL_linestr);
                            sv_setpv(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 = Nullch;
                            PL_preambled = FALSE;
                            if (PERLDB_LINE)
                                (void)gv_fetchfile(PL_origfilename);
                            PL_preambled = FALSE;
                            if (PERLDB_LINE)
                                (void)gv_fetchfile(PL_origfilename);
@@ -2758,7 +2834,7 @@ Perl_yylex(pTHX)
     case '\r':
 #ifdef PERL_STRICT_CR
        Perl_warn(aTHX_ "Illegal character \\%03o (carriage return)", '\r');
     case '\r':
 #ifdef PERL_STRICT_CR
        Perl_warn(aTHX_ "Illegal character \\%03o (carriage return)", '\r');
-       Perl_croak(aTHX_ 
+       Perl_croak(aTHX_
       "\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:
@@ -2794,6 +2870,8 @@ Perl_yylex(pTHX)
        goto retry;
     case '-':
        if (s[1] && isALPHA(s[1]) && !isALNUM(s[2])) {
        goto retry;
     case '-':
        if (s[1] && isALPHA(s[1]) && !isALNUM(s[2])) {
+           I32 ftst = 0;
+
            s++;
            PL_bufptr = s;
            tmp = *s++;
            s++;
            PL_bufptr = s;
            tmp = *s++;
@@ -2803,42 +2881,65 @@ Perl_yylex(pTHX)
 
            if (strnEQ(s,"=>",2)) {
                s = force_word(PL_bufptr,WORD,FALSE,FALSE,FALSE);
 
            if (strnEQ(s,"=>",2)) {
                s = force_word(PL_bufptr,WORD,FALSE,FALSE,FALSE);
+                DEBUG_T( { PerlIO_printf(Perl_debug_log,
+                            "### Saw unary minus before =>, forcing word '%s'\n", s);
+                } )
                OPERATOR('-');          /* unary minus */
            }
            PL_last_uni = PL_oldbufptr;
                OPERATOR('-');          /* unary minus */
            }
            PL_last_uni = PL_oldbufptr;
-           PL_last_lop_op = OP_FTEREAD;        /* good enough */
            switch (tmp) {
            switch (tmp) {
-           case 'r': FTST(OP_FTEREAD);
-           case 'w': FTST(OP_FTEWRITE);
-           case 'x': FTST(OP_FTEEXEC);
-           case 'o': FTST(OP_FTEOWNED);
-           case 'R': FTST(OP_FTRREAD);
-           case 'W': FTST(OP_FTRWRITE);
-           case 'X': FTST(OP_FTREXEC);
-           case 'O': FTST(OP_FTROWNED);
-           case 'e': FTST(OP_FTIS);
-           case 'z': FTST(OP_FTZERO);
-           case 's': FTST(OP_FTSIZE);
-           case 'f': FTST(OP_FTFILE);
-           case 'd': FTST(OP_FTDIR);
-           case 'l': FTST(OP_FTLINK);
-           case 'p': FTST(OP_FTPIPE);
-           case 'S': FTST(OP_FTSOCK);
-           case 'u': FTST(OP_FTSUID);
-           case 'g': FTST(OP_FTSGID);
-           case 'k': FTST(OP_FTSVTX);
-           case 'b': FTST(OP_FTBLK);
-           case 'c': FTST(OP_FTCHR);
-           case 't': FTST(OP_FTTTY);
-           case 'T': FTST(OP_FTTEXT);
-           case 'B': FTST(OP_FTBINARY);
-           case 'M': gv_fetchpv("\024",TRUE, SVt_PV); FTST(OP_FTMTIME);
-           case 'A': gv_fetchpv("\024",TRUE, SVt_PV); FTST(OP_FTATIME);
-           case 'C': gv_fetchpv("\024",TRUE, SVt_PV); FTST(OP_FTCTIME);
+           case 'r': ftst = OP_FTEREAD;        break;
+           case 'w': ftst = OP_FTEWRITE;       break;
+           case 'x': ftst = OP_FTEEXEC;        break;
+           case 'o': ftst = OP_FTEOWNED;       break;
+           case 'R': ftst = OP_FTRREAD;        break;
+           case 'W': ftst = OP_FTRWRITE;       break;
+           case 'X': ftst = OP_FTREXEC;        break;
+           case 'O': ftst = OP_FTROWNED;       break;
+           case 'e': ftst = OP_FTIS;           break;
+           case 'z': ftst = OP_FTZERO;         break;
+           case 's': ftst = OP_FTSIZE;         break;
+           case 'f': ftst = OP_FTFILE;         break;
+           case 'd': ftst = OP_FTDIR;          break;
+           case 'l': ftst = OP_FTLINK;         break;
+           case 'p': ftst = OP_FTPIPE;         break;
+           case 'S': ftst = OP_FTSOCK;         break;
+           case 'u': ftst = OP_FTSUID;         break;
+           case 'g': ftst = OP_FTSGID;         break;
+           case 'k': ftst = OP_FTSVTX;         break;
+           case 'b': ftst = OP_FTBLK;          break;
+           case 'c': ftst = OP_FTCHR;          break;
+           case 't': ftst = OP_FTTTY;          break;
+           case 'T': ftst = OP_FTTEXT;         break;
+           case 'B': ftst = OP_FTBINARY;       break;
+           case 'M': case 'A': case 'C':
+               gv_fetchpv("\024",TRUE, SVt_PV);
+               switch (tmp) {
+               case 'M': ftst = OP_FTMTIME;    break;
+               case 'A': ftst = OP_FTATIME;    break;
+               case 'C': ftst = OP_FTCTIME;    break;
+               default:                        break;
+               }
+               break;
            default:
            default:
-               Perl_croak(aTHX_ "Unrecognized file test: -%c", (int)tmp);
                break;
            }
                break;
            }
+           if (ftst) {
+               PL_last_lop_op = ftst;
+               DEBUG_T( { PerlIO_printf(Perl_debug_log,
+                        "### Saw file test %c\n", (int)ftst);
+               } )
+               FTST(ftst);
+           }
+           else {
+               /* Assume it was a minus followed by a one-letter named
+                * subroutine call (or a -bareword), then. */
+               DEBUG_T( { PerlIO_printf(Perl_debug_log,
+                       "### %c looked like a file test but was not\n",
+                       (int)ftst);
+               } )
+               s -= 2;
+           }
        }
        tmp = *s++;
        if (*s == tmp) {
        }
        tmp = *s++;
        if (*s == tmp) {
@@ -2967,10 +3068,6 @@ Perl_yylex(pTHX)
                if (*d == '(') {
                    d = scan_str(d,TRUE,TRUE);
                    if (!d) {
                if (*d == '(') {
                    d = scan_str(d,TRUE,TRUE);
                    if (!d) {
-                       if (PL_lex_stuff) {
-                           SvREFCNT_dec(PL_lex_stuff);
-                           PL_lex_stuff = Nullsv;
-                       }
                        /* MUST advance bufptr here to avoid bogus
                           "at end of line" context messages from yyerror().
                         */
                        /* MUST advance bufptr here to avoid bogus
                           "at end of line" context messages from yyerror().
                         */
@@ -2990,9 +3087,25 @@ Perl_yylex(pTHX)
                    PL_lex_stuff = Nullsv;
                }
                else {
                    PL_lex_stuff = Nullsv;
                }
                else {
-                   attrs = append_elem(OP_LIST, attrs,
-                                       newSVOP(OP_CONST, 0,
-                                               newSVpvn(s, len)));
+                   if (!PL_in_my && len == 6 && strnEQ(s, "lvalue", len))
+                       CvLVALUE_on(PL_compcv);
+                   else if (!PL_in_my && len == 6 && strnEQ(s, "locked", len))
+                       CvLOCKED_on(PL_compcv);
+                   else if (!PL_in_my && len == 6 && strnEQ(s, "method", len))
+                       CvMETHOD_on(PL_compcv);
+#ifdef USE_ITHREADS
+                   else if (PL_in_my == KEY_our && len == 6 && strnEQ(s, "shared", len))
+                       GvSHARED_on(cGVOPx_gv(yylval.opval));
+#endif
+                   /* After we've set the flags, it could be argued that
+                      we don't need to do the attributes.pm-based setting
+                      process, and shouldn't bother appending recognized
+                      flags. To experiment with that, uncomment the
+                      following "else": */
+                   else
+                       attrs = append_elem(OP_LIST, attrs,
+                                           newSVOP(OP_CONST, 0,
+                                                   newSVpvn(s, len)));
                }
                s = skipspace(d);
                if (*s == ':' && s[1] != ':')
                }
                s = skipspace(d);
                if (*s == ':' && s[1] != ':')
@@ -3536,8 +3649,8 @@ Perl_yylex(pTHX)
     case '?':                  /* may either be conditional or pattern */
        if (PL_expect != XOPERATOR) {
            /* Disable warning on "study /blah/" */
     case '?':                  /* may either be conditional or pattern */
        if (PL_expect != XOPERATOR) {
            /* Disable warning on "study /blah/" */
-           if (PL_oldoldbufptr == PL_last_uni 
-               && (*PL_last_uni != 's' || s - PL_last_uni < 5 
+           if (PL_oldoldbufptr == PL_last_uni
+               && (*PL_last_uni != 's' || s - PL_last_uni < 5
                    || memNE(PL_last_uni, "study", 5)
                    || isALNUM_lazy_if(PL_last_uni+5,UTF)))
                check_uni();
                    || memNE(PL_last_uni, "study", 5)
                    || isALNUM_lazy_if(PL_last_uni+5,UTF)))
                check_uni();
@@ -3582,12 +3695,18 @@ Perl_yylex(pTHX)
     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);
     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);
+        DEBUG_T( { PerlIO_printf(Perl_debug_log,
+                    "### Saw number in '%s'\n", s);
+        } )
        if (PL_expect == XOPERATOR)
            no_op("Number",s);
        TERM(THING);
 
     case '\'':
        s = scan_str(s,FALSE,FALSE);
        if (PL_expect == XOPERATOR)
            no_op("Number",s);
        TERM(THING);
 
     case '\'':
        s = scan_str(s,FALSE,FALSE);
+        DEBUG_T( { PerlIO_printf(Perl_debug_log,
+                    "### Saw string before '%s'\n", s);
+        } )
        if (PL_expect == XOPERATOR) {
            if (PL_lex_formbrack && PL_lex_brackets == PL_lex_formbrack) {
                PL_expect = XTERM;
        if (PL_expect == XOPERATOR) {
            if (PL_lex_formbrack && PL_lex_brackets == PL_lex_formbrack) {
                PL_expect = XTERM;
@@ -3604,6 +3723,9 @@ Perl_yylex(pTHX)
 
     case '"':
        s = scan_str(s,FALSE,FALSE);
 
     case '"':
        s = scan_str(s,FALSE,FALSE);
+        DEBUG_T( { PerlIO_printf(Perl_debug_log,
+                    "### Saw string before '%s'\n", s);
+        } )
        if (PL_expect == XOPERATOR) {
            if (PL_lex_formbrack && PL_lex_brackets == PL_lex_formbrack) {
                PL_expect = XTERM;
        if (PL_expect == XOPERATOR) {
            if (PL_lex_formbrack && PL_lex_brackets == PL_lex_formbrack) {
                PL_expect = XTERM;
@@ -3617,7 +3739,7 @@ Perl_yylex(pTHX)
            missingterm((char*)0);
        yylval.ival = OP_CONST;
        for (d = SvPV(PL_lex_stuff, len); len; len--, d++) {
            missingterm((char*)0);
        yylval.ival = OP_CONST;
        for (d = SvPV(PL_lex_stuff, len); len; len--, d++) {
-           if (*d == '$' || *d == '@' || *d == '\\' || *d & 0x80) {
+           if (*d == '$' || *d == '@' || *d == '\\' || UTF8_IS_CONTINUED(*d)) {
                yylval.ival = OP_STRINGIFY;
                break;
            }
                yylval.ival = OP_STRINGIFY;
                break;
            }
@@ -3626,6 +3748,9 @@ Perl_yylex(pTHX)
 
     case '`':
        s = scan_str(s,FALSE,FALSE);
 
     case '`':
        s = scan_str(s,FALSE,FALSE);
+        DEBUG_T( { PerlIO_printf(Perl_debug_log,
+                    "### Saw backtick string before '%s'\n", s);
+        } )
        if (PL_expect == XOPERATOR)
            no_op("Backticks",s);
        if (!s)
        if (PL_expect == XOPERATOR)
            no_op("Backticks",s);
        if (!s)
@@ -3741,6 +3866,8 @@ Perl_yylex(pTHX)
            CLINE;
            yylval.opval = (OP*)newSVOP(OP_CONST, 0, newSVpv(PL_tokenbuf,0));
            yylval.opval->op_private = OPpCONST_BARE;
            CLINE;
            yylval.opval = (OP*)newSVOP(OP_CONST, 0, newSVpv(PL_tokenbuf,0));
            yylval.opval->op_private = OPpCONST_BARE;
+           if (UTF && !IN_BYTE && is_utf8_string((U8*)PL_tokenbuf, len))
+             SvUTF8_on(((SVOP*)yylval.opval)->op_sv);
            TERM(WORD);
        }
 
            TERM(WORD);
        }
 
@@ -3825,7 +3952,7 @@ Perl_yylex(pTHX)
                    PL_tokenbuf[len - 2] == ':' && PL_tokenbuf[len - 1] == ':')
                {
                    if (ckWARN(WARN_BAREWORD) && ! gv_fetchpv(PL_tokenbuf, FALSE, SVt_PVHV))
                    PL_tokenbuf[len - 2] == ':' && PL_tokenbuf[len - 1] == ':')
                {
                    if (ckWARN(WARN_BAREWORD) && ! gv_fetchpv(PL_tokenbuf, FALSE, SVt_PVHV))
-                       Perl_warner(aTHX_ WARN_BAREWORD, 
+                       Perl_warner(aTHX_ WARN_BAREWORD,
                            "Bareword \"%s\" refers to nonexistent package",
                             PL_tokenbuf);
                    len -= 2;
                            "Bareword \"%s\" refers to nonexistent package",
                             PL_tokenbuf);
                    len -= 2;
@@ -3882,10 +4009,10 @@ Perl_yylex(pTHX)
                    /* If not a declared subroutine, it's an indirect object. */
                    /* (But it's an indir obj regardless for sort.) */
 
                    /* If not a declared subroutine, it's an indirect object. */
                    /* (But it's an indir obj regardless for sort.) */
 
-                   if ((PL_last_lop_op == OP_SORT ||
-                         (!immediate_paren && (!gv || !GvCVu(gv)))) &&
+                   if ( !immediate_paren && (PL_last_lop_op == OP_SORT ||
+                         ((!gv || !GvCVu(gv)) &&
                         (PL_last_lop_op != OP_MAPSTART &&
                         (PL_last_lop_op != OP_MAPSTART &&
-                        PL_last_lop_op != OP_GREPSTART))
+                        PL_last_lop_op != OP_GREPSTART))))
                    {
                        PL_expect = (PL_last_lop == PL_oldoldbufptr) ? XTERM : XOPERATOR;
                        goto bareword;
                    {
                        PL_expect = (PL_last_lop == PL_oldoldbufptr) ? XTERM : XOPERATOR;
                        goto bareword;
@@ -3900,6 +4027,8 @@ Perl_yylex(pTHX)
                if (*s == '=' && s[1] == '>') {
                    CLINE;
                    sv_setpv(((SVOP*)yylval.opval)->op_sv, PL_tokenbuf);
                if (*s == '=' && s[1] == '>') {
                    CLINE;
                    sv_setpv(((SVOP*)yylval.opval)->op_sv, PL_tokenbuf);
+                   if (UTF && !IN_BYTE && is_utf8_string((U8*)PL_tokenbuf, len))
+                     SvUTF8_on(((SVOP*)yylval.opval)->op_sv);
                    TERM(WORD);
                }
 
                    TERM(WORD);
                }
 
@@ -4062,15 +4191,15 @@ Perl_yylex(pTHX)
                        (void)PerlIO_seek(PL_rsfp, 0L, 0);
                    }
                    if (PerlLIO_setmode(PerlIO_fileno(PL_rsfp), O_TEXT) != -1) {
                        (void)PerlIO_seek(PL_rsfp, 0L, 0);
                    }
                    if (PerlLIO_setmode(PerlIO_fileno(PL_rsfp), O_TEXT) != -1) {
-#if defined(__BORLANDC__)
-                       /* XXX see note in do_binmode() */
-                       ((FILE*)PL_rsfp)->flags |= _F_BIN;
-#endif
                        if (loc > 0)
                            PerlIO_seek(PL_rsfp, loc, 0);
                    }
                }
 #endif
                        if (loc > 0)
                            PerlIO_seek(PL_rsfp, loc, 0);
                    }
                }
 #endif
+#ifdef PERLIO_LAYERS
+               if (UTF && !IN_BYTE)
+                   PerlIO_apply_layers(aTHX_ PL_rsfp, NULL, ":utf8");
+#endif
                PL_rsfp = Nullfp;
            }
            goto fake_eof;
                PL_rsfp = Nullfp;
            }
            goto fake_eof;
@@ -4221,7 +4350,7 @@ Perl_yylex(pTHX)
 
        case KEY_exists:
            UNI(OP_EXISTS);
 
        case KEY_exists:
            UNI(OP_EXISTS);
-           
+       
        case KEY_exit:
            UNI(OP_EXIT);
 
        case KEY_exit:
            UNI(OP_EXIT);
 
@@ -4425,7 +4554,7 @@ Perl_yylex(pTHX)
        case KEY_last:
            s = force_word(s,WORD,TRUE,FALSE,FALSE);
            LOOPX(OP_LAST);
        case KEY_last:
            s = force_word(s,WORD,TRUE,FALSE,FALSE);
            LOOPX(OP_LAST);
-           
+       
        case KEY_lc:
            UNI(OP_LC);
 
        case KEY_lc:
            UNI(OP_LC);
 
@@ -4570,7 +4699,7 @@ Perl_yylex(pTHX)
 
        case KEY_pos:
            UNI(OP_POS);
 
        case KEY_pos:
            UNI(OP_POS);
-           
+       
        case KEY_pack:
            LOP(OP_PACK,XTERM);
 
        case KEY_pack:
            LOP(OP_PACK,XTERM);
 
@@ -4601,6 +4730,7 @@ Perl_yylex(pTHX)
                int warned = 0;
                d = SvPV_force(PL_lex_stuff, len);
                while (len) {
                int warned = 0;
                d = SvPV_force(PL_lex_stuff, len);
                while (len) {
+                   SV *sv;
                    for (; isSPACE(*d) && len; --len, ++d) ;
                    if (len) {
                        char *b = d;
                    for (; isSPACE(*d) && len; --len, ++d) ;
                    if (len) {
                        char *b = d;
@@ -4621,8 +4751,11 @@ Perl_yylex(pTHX)
                        else {
                            for (; !isSPACE(*d) && len; --len, ++d) ;
                        }
                        else {
                            for (; !isSPACE(*d) && len; --len, ++d) ;
                        }
+                       sv = newSVpvn(b, d-b);
+                       if (DO_UTF8(PL_lex_stuff))
+                           SvUTF8_on(sv);
                        words = append_elem(OP_LIST, words,
                        words = append_elem(OP_LIST, words,
-                                           newSVOP(OP_CONST, 0, tokeq(newSVpvn(b, d-b))));
+                                           newSVOP(OP_CONST, 0, tokeq(sv)));
                    }
                }
                if (words) {
                    }
                }
                if (words) {
@@ -4630,9 +4763,10 @@ Perl_yylex(pTHX)
                    force_next(THING);
                }
            }
                    force_next(THING);
                }
            }
-           if (PL_lex_stuff)
+           if (PL_lex_stuff) {
                SvREFCNT_dec(PL_lex_stuff);
                SvREFCNT_dec(PL_lex_stuff);
-           PL_lex_stuff = Nullsv;
+               PL_lex_stuff = Nullsv;
+           }
            PL_expect = XTERM;
            TOKEN('(');
 
            PL_expect = XTERM;
            TOKEN('(');
 
@@ -4732,7 +4866,7 @@ Perl_yylex(pTHX)
 
        case KEY_chomp:
            UNI(OP_CHOMP);
 
        case KEY_chomp:
            UNI(OP_CHOMP);
-           
+       
        case KEY_scalar:
            UNI(OP_SCALAR);
 
        case KEY_scalar:
            UNI(OP_SCALAR);
 
@@ -4900,12 +5034,8 @@ Perl_yylex(pTHX)
                    char *p;
 
                    s = scan_str(s,FALSE,FALSE);
                    char *p;
 
                    s = scan_str(s,FALSE,FALSE);
-                   if (!s) {
-                       if (PL_lex_stuff)
-                           SvREFCNT_dec(PL_lex_stuff);
-                       PL_lex_stuff = Nullsv;
+                   if (!s)
                        Perl_croak(aTHX_ "Prototype not terminated");
                        Perl_croak(aTHX_ "Prototype not terminated");
-                   }
                    /* strip spaces */
                    d = SvPVX(PL_lex_stuff);
                    tmp = 0;
                    /* strip spaces */
                    d = SvPVX(PL_lex_stuff);
                    tmp = 0;
@@ -5021,7 +5151,7 @@ Perl_yylex(pTHX)
        case KEY_umask:
            if (ckWARN(WARN_UMASK)) {
                for (d = s; d < PL_bufend && (isSPACE(*d) || *d == '('); d++) ;
        case KEY_umask:
            if (ckWARN(WARN_UMASK)) {
                for (d = s; d < PL_bufend && (isSPACE(*d) || *d == '('); d++) ;
-               if (*d != '0' && isDIGIT(*d)) 
+               if (*d != '0' && isDIGIT(*d))
                    Perl_warner(aTHX_ WARN_UMASK,
                                "umask: argument is missing initial 0");
            }
                    Perl_warner(aTHX_ WARN_UMASK,
                                "umask: argument is missing initial 0");
            }
@@ -5076,7 +5206,7 @@ Perl_yylex(pTHX)
        {
            static char ctl_l[2];
 
        {
            static char ctl_l[2];
 
-           if (ctl_l[0] == '\0') 
+           if (ctl_l[0] == '\0')
                ctl_l[0] = toCTRL('L');
            gv_fetchpv(ctl_l,TRUE, SVt_PV);
        }
                ctl_l[0] = toCTRL('L');
            gv_fetchpv(ctl_l,TRUE, SVt_PV);
        }
@@ -5448,7 +5578,7 @@ Perl_keyword(pTHX_ register char *d, I32 len)
     case 'p':
        switch (len) {
        case 3:
     case 'p':
        switch (len) {
        case 3:
-           if (strEQ(d,"pop"))                 return -KEY_pop; 
+           if (strEQ(d,"pop"))                 return -KEY_pop;
            if (strEQ(d,"pos"))                 return KEY_pos;
            break;
        case 4:
            if (strEQ(d,"pos"))                 return KEY_pos;
            break;
        case 4:
@@ -5714,7 +5844,6 @@ S_checkcomma(pTHX_ register char *s, char *name, char *what)
     char *w;
 
     if (*s == ' ' && s[1] == '(') {    /* XXX gotta be a better way */
     char *w;
 
     if (*s == ' ' && s[1] == '(') {    /* XXX gotta be a better way */
-       dTHR;                           /* only for ckWARN */
        if (ckWARN(WARN_SYNTAX)) {
            int level = 1;
            for (w = s+2; *w && level; w++) {
        if (ckWARN(WARN_SYNTAX)) {
            int level = 1;
            for (w = s+2; *w && level; w++) {
@@ -5769,14 +5898,14 @@ S_new_constant(pTHX_ char *s, STRLEN len, const char *key, SV *sv, SV *pv,
     SV **cvp;
     SV *cv, *typesv;
     const char *why1, *why2, *why3;
     SV **cvp;
     SV *cv, *typesv;
     const char *why1, *why2, *why3;
-    
+
     if (!table || !(PL_hints & HINT_LOCALIZE_HH)) {
        SV *msg;
        
        why2 = strEQ(key,"charnames")
               ? "(possibly a missing \"use charnames ...\")"
               : "";
     if (!table || !(PL_hints & HINT_LOCALIZE_HH)) {
        SV *msg;
        
        why2 = strEQ(key,"charnames")
               ? "(possibly a missing \"use charnames ...\")"
               : "";
-       msg = Perl_newSVpvf(aTHX_ "Constant(%s) unknown: %s", 
+       msg = Perl_newSVpvf(aTHX_ "Constant(%s) unknown: %s",
                            (type ? type: "undef"), why2);
 
        /* This is convoluted and evil ("goto considered harmful")
                            (type ? type: "undef"), why2);
 
        /* This is convoluted and evil ("goto considered harmful")
@@ -5787,7 +5916,7 @@ S_new_constant(pTHX_ char *s, STRLEN len, const char *key, SV *sv, SV *pv,
        goto msgdone;
 
     report:
        goto msgdone;
 
     report:
-       msg = Perl_newSVpvf(aTHX_ "Constant(%s): %s%s%s", 
+       msg = Perl_newSVpvf(aTHX_ "Constant(%s): %s%s%s",
                            (type ? type: "undef"), why1, why2, why3);
     msgdone:
        yyerror(SvPVX(msg));
                            (type ? type: "undef"), why1, why2, why3);
     msgdone:
        yyerror(SvPVX(msg));
@@ -5809,11 +5938,11 @@ S_new_constant(pTHX_ char *s, STRLEN len, const char *key, SV *sv, SV *pv,
        typesv = sv_2mortal(newSVpv(type, 0));
     else
        typesv = &PL_sv_undef;
        typesv = sv_2mortal(newSVpv(type, 0));
     else
        typesv = &PL_sv_undef;
-    
+
     PUSHSTACKi(PERLSI_OVERLOAD);
     ENTER ;
     SAVETMPS;
     PUSHSTACKi(PERLSI_OVERLOAD);
     ENTER ;
     SAVETMPS;
-    
+
     PUSHMARK(SP) ;
     EXTEND(sp, 3);
     if (pv)
     PUSHMARK(SP) ;
     EXTEND(sp, 3);
     if (pv)
@@ -5823,9 +5952,9 @@ S_new_constant(pTHX_ char *s, STRLEN len, const char *key, SV *sv, SV *pv,
        PUSHs(typesv);
     PUTBACK;
     call_sv(cv, G_SCALAR | ( PL_in_eval ? 0 : G_EVAL));
        PUSHs(typesv);
     PUTBACK;
     call_sv(cv, G_SCALAR | ( PL_in_eval ? 0 : G_EVAL));
-    
+
     SPAGAIN ;
     SPAGAIN ;
-    
+
     /* Check the eval first */
     if (!PL_in_eval && SvTRUE(ERRSV)) {
        STRLEN n_a;
     /* Check the eval first */
     if (!PL_in_eval && SvTRUE(ERRSV)) {
        STRLEN n_a;
@@ -5838,12 +5967,12 @@ S_new_constant(pTHX_ char *s, STRLEN len, const char *key, SV *sv, SV *pv,
        res = POPs;
        (void)SvREFCNT_inc(res);
     }
        res = POPs;
        (void)SvREFCNT_inc(res);
     }
-    
+
     PUTBACK ;
     FREETMPS ;
     LEAVE ;
     POPSTACK;
     PUTBACK ;
     FREETMPS ;
     LEAVE ;
     POPSTACK;
-    
+
     if (!SvOK(res)) {
        why1 = "Call to &{$^H{";
        why2 = key;
     if (!SvOK(res)) {
        why1 = "Call to &{$^H{";
        why2 = key;
@@ -5854,7 +5983,7 @@ S_new_constant(pTHX_ char *s, STRLEN len, const char *key, SV *sv, SV *pv,
 
     return res;
 }
 
     return res;
 }
-  
+
 STATIC char *
 S_scan_word(pTHX_ register char *s, char *dest, STRLEN destlen, int allow_package, STRLEN *slp)
 {
 STATIC char *
 S_scan_word(pTHX_ register char *s, char *dest, STRLEN destlen, int allow_package, STRLEN *slp)
 {
@@ -5874,9 +6003,9 @@ S_scan_word(pTHX_ register char *s, char *dest, STRLEN destlen, int allow_packag
            *d++ = *s++;
            *d++ = *s++;
        }
            *d++ = *s++;
            *d++ = *s++;
        }
-       else if (UTF && *(U8*)s >= 0xc0 && isALNUM_utf8((U8*)s)) {
+       else if (UTF && UTF8_IS_START(*s) && isALNUM_utf8((U8*)s)) {
            char *t = s + UTF8SKIP(s);
            char *t = s + UTF8SKIP(s);
-           while (*t & 0x80 && is_utf8_mark((U8*)t))
+           while (UTF8_IS_CONTINUED(*t) && is_utf8_mark((U8*)t))
                t += UTF8SKIP(t);
            if (d + (t - s) > e)
                Perl_croak(aTHX_ ident_too_long);
                t += UTF8SKIP(t);
            if (d + (t - s) > e)
                Perl_croak(aTHX_ ident_too_long);
@@ -5926,9 +6055,9 @@ S_scan_ident(pTHX_ register char *s, register char *send, char *dest, STRLEN des
                *d++ = *s++;
                *d++ = *s++;
            }
                *d++ = *s++;
                *d++ = *s++;
            }
-           else if (UTF && *(U8*)s >= 0xc0 && isALNUM_utf8((U8*)s)) {
+           else if (UTF && UTF8_IS_START(*s) && isALNUM_utf8((U8*)s)) {
                char *t = s + UTF8SKIP(s);
                char *t = s + UTF8SKIP(s);
-               while (*t & 0x80 && is_utf8_mark((U8*)t))
+               while (UTF8_IS_CONTINUED(*t) && is_utf8_mark((U8*)t))
                    t += UTF8SKIP(t);
                if (d + (t - s) > e)
                    Perl_croak(aTHX_ ident_too_long);
                    t += UTF8SKIP(t);
                if (d + (t - s) > e)
                    Perl_croak(aTHX_ ident_too_long);
@@ -5981,7 +6110,7 @@ S_scan_ident(pTHX_ register char *s, register char *send, char *dest, STRLEN des
                e = s;
                while ((e < send && isALNUM_lazy_if(e,UTF)) || *e == ':') {
                    e += UTF8SKIP(e);
                e = s;
                while ((e < send && isALNUM_lazy_if(e,UTF)) || *e == ':') {
                    e += UTF8SKIP(e);
-                   while (e < send && *e & 0x80 && is_utf8_mark((U8*)e))
+                   while (e < send && UTF8_IS_CONTINUED(*e) && is_utf8_mark((U8*)e))
                        e += UTF8SKIP(e);
                }
                Copy(s, d, e - s, char);
                        e += UTF8SKIP(e);
                }
                Copy(s, d, e - s, char);
@@ -5997,7 +6126,6 @@ S_scan_ident(pTHX_ register char *s, register char *send, char *dest, STRLEN des
            *d = '\0';
            while (s < send && SPACE_OR_TAB(*s)) s++;
            if ((*s == '[' || (*s == '{' && strNE(dest, "sub")))) {
            *d = '\0';
            while (s < send && SPACE_OR_TAB(*s)) s++;
            if ((*s == '[' || (*s == '{' && strNE(dest, "sub")))) {
-               dTHR;                   /* only for ckWARN */
                if (ckWARN(WARN_AMBIGUOUS) && keyword(dest, d - dest)) {
                    const char *brack = *s == '[' ? "[...]" : "{...}";
                    Perl_warner(aTHX_ WARN_AMBIGUOUS,
                if (ckWARN(WARN_AMBIGUOUS) && keyword(dest, d - dest)) {
                    const char *brack = *s == '[' ? "[...]" : "{...}";
                    Perl_warner(aTHX_ WARN_AMBIGUOUS,
@@ -6008,8 +6136,8 @@ S_scan_ident(pTHX_ register char *s, register char *send, char *dest, STRLEN des
                PL_lex_brackstack[PL_lex_brackets++] = (char)(XOPERATOR | XFAKEBRACK);
                return s;
            }
                PL_lex_brackstack[PL_lex_brackets++] = (char)(XOPERATOR | XFAKEBRACK);
                return s;
            }
-       } 
-       /* Handle extended ${^Foo} variables 
+       }
+       /* Handle extended ${^Foo} variables
         * 1999-02-27 mjd-perl-patch@plover.com */
        else if (!isALNUM(*d) && !isPRINT(*d) /* isCTRL(d) */
                 && isALNUM(*s))
         * 1999-02-27 mjd-perl-patch@plover.com */
        else if (!isALNUM(*d) && !isPRINT(*d) /* isCTRL(d) */
                 && isALNUM(*s))
@@ -6029,7 +6157,6 @@ S_scan_ident(pTHX_ register char *s, register char *send, char *dest, STRLEN des
            if (funny == '#')
                funny = '@';
            if (PL_lex_state == LEX_NORMAL) {
            if (funny == '#')
                funny = '@';
            if (PL_lex_state == LEX_NORMAL) {
-               dTHR;                   /* only for ckWARN */
                if (ckWARN(WARN_AMBIGUOUS) &&
                    (keyword(dest, d - dest) || get_cv(dest, FALSE)))
                {
                if (ckWARN(WARN_AMBIGUOUS) &&
                    (keyword(dest, d - dest) || get_cv(dest, FALSE)))
                {
@@ -6075,12 +6202,8 @@ S_scan_pat(pTHX_ char *start, I32 type)
     char *s;
 
     s = scan_str(start,FALSE,FALSE);
     char *s;
 
     s = scan_str(start,FALSE,FALSE);
-    if (!s) {
-       if (PL_lex_stuff)
-           SvREFCNT_dec(PL_lex_stuff);
-       PL_lex_stuff = Nullsv;
+    if (!s)
        Perl_croak(aTHX_ "Search pattern not terminated");
        Perl_croak(aTHX_ "Search pattern not terminated");
-    }
 
     pm = (PMOP*)newPMOP(type, 0);
     if (PL_multi_open == '?')
 
     pm = (PMOP*)newPMOP(type, 0);
     if (PL_multi_open == '?')
@@ -6112,12 +6235,8 @@ S_scan_subst(pTHX_ char *start)
 
     s = scan_str(start,FALSE,FALSE);
 
 
     s = scan_str(start,FALSE,FALSE);
 
-    if (!s) {
-       if (PL_lex_stuff)
-           SvREFCNT_dec(PL_lex_stuff);
-       PL_lex_stuff = Nullsv;
+    if (!s)
        Perl_croak(aTHX_ "Substitution pattern not terminated");
        Perl_croak(aTHX_ "Substitution pattern not terminated");
-    }
 
     if (s[-1] == PL_multi_open)
        s--;
 
     if (s[-1] == PL_multi_open)
        s--;
@@ -6125,12 +6244,10 @@ S_scan_subst(pTHX_ char *start)
     first_start = PL_multi_start;
     s = scan_str(s,FALSE,FALSE);
     if (!s) {
     first_start = PL_multi_start;
     s = scan_str(s,FALSE,FALSE);
     if (!s) {
-       if (PL_lex_stuff)
+       if (PL_lex_stuff) {
            SvREFCNT_dec(PL_lex_stuff);
            SvREFCNT_dec(PL_lex_stuff);
-       PL_lex_stuff = Nullsv;
-       if (PL_lex_repl)
-           SvREFCNT_dec(PL_lex_repl);
-       PL_lex_repl = Nullsv;
+           PL_lex_stuff = Nullsv;
+       }
        Perl_croak(aTHX_ "Substitution replacement not terminated");
     }
     PL_multi_start = first_start;      /* so whole substitution is taken together */
        Perl_croak(aTHX_ "Substitution replacement not terminated");
     }
     PL_multi_start = first_start;      /* so whole substitution is taken together */
@@ -6179,35 +6296,24 @@ S_scan_trans(pTHX_ char *start)
     I32 squash;
     I32 del;
     I32 complement;
     I32 squash;
     I32 del;
     I32 complement;
-    I32 utf8;
-    I32 count = 0;
 
     yylval.ival = OP_NULL;
 
     s = scan_str(start,FALSE,FALSE);
 
     yylval.ival = OP_NULL;
 
     s = scan_str(start,FALSE,FALSE);
-    if (!s) {
-       if (PL_lex_stuff)
-           SvREFCNT_dec(PL_lex_stuff);
-       PL_lex_stuff = Nullsv;
+    if (!s)
        Perl_croak(aTHX_ "Transliteration pattern not terminated");
        Perl_croak(aTHX_ "Transliteration pattern not terminated");
-    }
     if (s[-1] == PL_multi_open)
        s--;
 
     s = scan_str(s,FALSE,FALSE);
     if (!s) {
     if (s[-1] == PL_multi_open)
        s--;
 
     s = scan_str(s,FALSE,FALSE);
     if (!s) {
-       if (PL_lex_stuff)
+       if (PL_lex_stuff) {
            SvREFCNT_dec(PL_lex_stuff);
            SvREFCNT_dec(PL_lex_stuff);
-       PL_lex_stuff = Nullsv;
-       if (PL_lex_repl)
-           SvREFCNT_dec(PL_lex_repl);
-       PL_lex_repl = Nullsv;
+           PL_lex_stuff = Nullsv;
+       }
        Perl_croak(aTHX_ "Transliteration replacement not terminated");
     }
 
        Perl_croak(aTHX_ "Transliteration replacement not terminated");
     }
 
-    New(803,tbl,256,short);
-    o = newPVOP(OP_TRANS, 0, (char*)tbl);
-
     complement = del = squash = 0;
     while (strchr("cds", *s)) {
        if (*s == 'c')
     complement = del = squash = 0;
     while (strchr("cds", *s)) {
        if (*s == 'c')
@@ -6218,7 +6324,12 @@ S_scan_trans(pTHX_ char *start)
            squash = OPpTRANS_SQUASH;
        s++;
     }
            squash = OPpTRANS_SQUASH;
        s++;
     }
-    o->op_private = del|squash|complement;
+
+    New(803, tbl, complement&&!del?258:256, short);
+    o = newPVOP(OP_TRANS, 0, (char*)tbl);
+    o->op_private = del|squash|complement|
+      (DO_UTF8(PL_lex_stuff)? OPpTRANS_FROM_UTF : 0)|
+      (DO_UTF8(PL_lex_repl) ? OPpTRANS_TO_UTF   : 0);
 
     PL_lex_op = o;
     yylval.ival = OP_TRANS;
 
     PL_lex_op = o;
     yylval.ival = OP_TRANS;
@@ -6228,7 +6339,6 @@ S_scan_trans(pTHX_ char *start)
 STATIC char *
 S_scan_heredoc(pTHX_ register char *s)
 {
 STATIC char *
 S_scan_heredoc(pTHX_ register char *s)
 {
-    dTHR;
     SV *herewas;
     I32 op_type = OP_SCALAR;
     I32 len;
     SV *herewas;
     I32 op_type = OP_SCALAR;
     I32 len;
@@ -6361,6 +6471,7 @@ S_scan_heredoc(pTHX_ register char *s)
        sv_setsv(PL_linestr,herewas);
        PL_oldoldbufptr = PL_oldbufptr = PL_bufptr = s = PL_linestart = SvPVX(PL_linestr);
        PL_bufend = SvPVX(PL_linestr) + SvCUR(PL_linestr);
        sv_setsv(PL_linestr,herewas);
        PL_oldoldbufptr = PL_oldbufptr = PL_bufptr = s = PL_linestart = SvPVX(PL_linestr);
        PL_bufend = SvPVX(PL_linestr) + SvCUR(PL_linestr);
+       PL_last_lop = PL_last_uni = Nullch;
     }
     else
        sv_setpvn(tmpstr,"",0);   /* avoid "uninitialized" warning */
     }
     else
        sv_setpvn(tmpstr,"",0);   /* avoid "uninitialized" warning */
@@ -6372,6 +6483,7 @@ S_scan_heredoc(pTHX_ register char *s)
        }
        CopLINE_inc(PL_curcop);
        PL_bufend = SvPVX(PL_linestr) + SvCUR(PL_linestr);
        }
        CopLINE_inc(PL_curcop);
        PL_bufend = SvPVX(PL_linestr) + SvCUR(PL_linestr);
+       PL_last_lop = PL_last_uni = Nullch;
 #ifndef PERL_STRICT_CR
        if (PL_bufend - PL_linestart >= 2) {
            if ((PL_bufend[-2] == '\r' && PL_bufend[-1] == '\n') ||
 #ifndef PERL_STRICT_CR
        if (PL_bufend - PL_linestart >= 2) {
            if ((PL_bufend[-2] == '\r' && PL_bufend[-1] == '\n') ||
@@ -6413,6 +6525,8 @@ retval:
        Renew(SvPVX(tmpstr), SvLEN(tmpstr), char);
     }
     SvREFCNT_dec(herewas);
        Renew(SvPVX(tmpstr), SvLEN(tmpstr), char);
     }
     SvREFCNT_dec(herewas);
+    if (UTF && !IN_BYTE && is_utf8_string((U8*)SvPVX(tmpstr), SvCUR(tmpstr)))
+       SvUTF8_on(tmpstr);
     PL_lex_stuff = tmpstr;
     yylval.ival = op_type;
     return s;
     PL_lex_stuff = tmpstr;
     yylval.ival = op_type;
     return s;
@@ -6563,24 +6677,23 @@ S_scan_inputsymbol(pTHX_ char *start)
    calls scan_str().  s/// makes yylex() call scan_subst() which calls
    scan_str().  tr/// and y/// make yylex() call scan_trans() which
    calls scan_str().
    calls scan_str().  s/// makes yylex() call scan_subst() which calls
    scan_str().  tr/// and y/// make yylex() call scan_trans() which
    calls scan_str().
-      
+
    It skips whitespace before the string starts, and treats the first
    character as the delimiter.  If the delimiter is one of ([{< then
    the corresponding "close" character )]}> is used as the closing
    delimiter.  It allows quoting of delimiters, and if the string has
    balanced delimiters ([{<>}]) it allows nesting.
 
    It skips whitespace before the string starts, and treats the first
    character as the delimiter.  If the delimiter is one of ([{< then
    the corresponding "close" character )]}> is used as the closing
    delimiter.  It allows quoting of delimiters, and if the string has
    balanced delimiters ([{<>}]) it allows nesting.
 
-   The lexer always reads these strings into lex_stuff, except in the
-   case of the operators which take *two* arguments (s/// and tr///)
-   when it checks to see if lex_stuff is full (presumably with the 1st
-   arg to s or tr) and if so puts the string into lex_repl.
-
+   On success, the SV with the resulting string is put into lex_stuff or,
+   if that is already non-NULL, into lex_repl. The second case occurs only
+   when parsing the RHS of the special constructs s/// and tr/// (y///).
+   For convenience, the terminating delimiter character is stuffed into
+   SvIVX of the SV.
 */
 
 STATIC char *
 S_scan_str(pTHX_ char *start, int keep_quoted, int keep_delims)
 {
 */
 
 STATIC char *
 S_scan_str(pTHX_ char *start, int keep_quoted, int keep_delims)
 {
-    dTHR;
     SV *sv;                            /* scalar value: string */
     char *tmps;                                /* temp string, used for delimiter matching */
     register char *s = start;          /* current position in the buffer */
     SV *sv;                            /* scalar value: string */
     char *tmps;                                /* temp string, used for delimiter matching */
     register char *s = start;          /* current position in the buffer */
@@ -6598,7 +6711,7 @@ S_scan_str(pTHX_ char *start, int keep_quoted, int keep_delims)
 
     /* after skipping whitespace, the next character is the terminator */
     term = *s;
 
     /* after skipping whitespace, the next character is the terminator */
     term = *s;
-    if ((term & 0x80) && UTF)
+    if (UTF8_IS_CONTINUED(term) && UTF)
        has_utf8 = TRUE;
 
     /* mark where we are */
        has_utf8 = TRUE;
 
     /* mark where we are */
@@ -6645,7 +6758,7 @@ S_scan_str(pTHX_ char *start, int keep_quoted, int keep_delims)
                   have found the terminator */
                else if (*s == term)
                    break;
                   have found the terminator */
                else if (*s == term)
                    break;
-               else if (!has_utf8 && (*s & 0x80) && UTF)
+               else if (!has_utf8 && UTF8_IS_CONTINUED(*s) && UTF)
                    has_utf8 = TRUE;
                *to = *s;
            }
                    has_utf8 = TRUE;
                *to = *s;
            }
@@ -6674,7 +6787,7 @@ S_scan_str(pTHX_ char *start, int keep_quoted, int keep_delims)
                    break;
                else if (*s == PL_multi_open)
                    brackets++;
                    break;
                else if (*s == PL_multi_open)
                    brackets++;
-               else if (!has_utf8 && (*s & 0x80) && UTF)
+               else if (!has_utf8 && UTF8_IS_CONTINUED(*s) && UTF)
                    has_utf8 = TRUE;
                *to = *s;
            }
                    has_utf8 = TRUE;
                *to = *s;
            }
@@ -6729,8 +6842,9 @@ S_scan_str(pTHX_ char *start, int keep_quoted, int keep_delims)
 
        /* having changed the buffer, we must update PL_bufend */
        PL_bufend = SvPVX(PL_linestr) + SvCUR(PL_linestr);
 
        /* having changed the buffer, we must update PL_bufend */
        PL_bufend = SvPVX(PL_linestr) + SvCUR(PL_linestr);
+       PL_last_lop = PL_last_uni = Nullch;
     }
     }
-    
+
     /* at this point, we have successfully read the delimited string */
 
     if (keep_delims)
     /* at this point, we have successfully read the delimited string */
 
     if (keep_delims)
@@ -6749,7 +6863,7 @@ S_scan_str(pTHX_ char *start, int keep_quoted, int keep_delims)
     /* decide whether this is the first or second quoted string we've read
        for this op
     */
     /* decide whether this is the first or second quoted string we've read
        for this op
     */
-    
+
     if (PL_lex_stuff)
        PL_lex_repl = sv;
     else
     if (PL_lex_stuff)
        PL_lex_repl = sv;
     else
@@ -6778,7 +6892,7 @@ S_scan_str(pTHX_ char *start, int keep_quoted, int keep_delims)
   try converting the number to an integer and see if it can do so
   without loss of precision.
 */
   try converting the number to an integer and see if it can do so
   without loss of precision.
 */
-  
+
 char *
 Perl_scan_num(pTHX_ char *start, YYSTYPE* lvalp)
 {
 char *
 Perl_scan_num(pTHX_ char *start, YYSTYPE* lvalp)
 {
@@ -6796,7 +6910,7 @@ Perl_scan_num(pTHX_ char *start, YYSTYPE* lvalp)
     switch (*s) {
     default:
       Perl_croak(aTHX_ "panic: scan_num");
     switch (*s) {
     default:
       Perl_croak(aTHX_ "panic: scan_num");
-      
+
     /* if it starts with a 0, it could be an octal number, a decimal in
        0.13 disguise, or a hexadecimal number, or a binary number. */
     case '0':
     /* if it starts with a 0, it could be an octal number, a decimal in
        0.13 disguise, or a hexadecimal number, or a binary number. */
     case '0':
@@ -6811,7 +6925,6 @@ Perl_scan_num(pTHX_ char *start, YYSTYPE* lvalp)
             we in octal/hex/binary?" indicator to disallow hex characters
             when in octal mode.
           */
             we in octal/hex/binary?" indicator to disallow hex characters
             when in octal mode.
           */
-           dTHR;
            NV n = 0.0;
            UV u = 0;
            I32 shift;
            NV n = 0.0;
            UV u = 0;
            I32 shift;
@@ -6899,7 +7012,6 @@ Perl_scan_num(pTHX_ char *start, YYSTYPE* lvalp)
 
                        if ((x >> shift) != u
                            && !(PL_hints & HINT_NEW_BINARY)) {
 
                        if ((x >> shift) != u
                            && !(PL_hints & HINT_NEW_BINARY)) {
-                           dTHR;
                            overflowed = TRUE;
                            n = (NV) u;
                            if (ckWARN_d(WARN_OVERFLOW))
                            overflowed = TRUE;
                            n = (NV) u;
                            if (ckWARN_d(WARN_OVERFLOW))
@@ -6931,7 +7043,6 @@ Perl_scan_num(pTHX_ char *start, YYSTYPE* lvalp)
          out:
            sv = NEWSV(92,0);
            if (overflowed) {
          out:
            sv = NEWSV(92,0);
            if (overflowed) {
-               dTHR;
                if (ckWARN(WARN_PORTABLE) && n > 4294967295.0)
                    Perl_warner(aTHX_ WARN_PORTABLE,
                                "%s number > %s non-portable",
                if (ckWARN(WARN_PORTABLE) && n > 4294967295.0)
                    Perl_warner(aTHX_ WARN_PORTABLE,
                                "%s number > %s non-portable",
@@ -6940,7 +7051,6 @@ Perl_scan_num(pTHX_ char *start, YYSTYPE* lvalp)
            }
            else {
 #if UVSIZE > 4
            }
            else {
 #if UVSIZE > 4
-               dTHR;
                if (ckWARN(WARN_PORTABLE) && u > 0xffffffff)
                    Perl_warner(aTHX_ WARN_PORTABLE,
                                "%s number > %s non-portable",
                if (ckWARN(WARN_PORTABLE) && u > 0xffffffff)
                    Perl_warner(aTHX_ WARN_PORTABLE,
                                "%s number > %s non-portable",
@@ -6966,11 +7076,10 @@ Perl_scan_num(pTHX_ char *start, YYSTYPE* lvalp)
 
        /* read next group of digits and _ and copy into d */
        while (isDIGIT(*s) || *s == '_') {
 
        /* read next group of digits and _ and copy into d */
        while (isDIGIT(*s) || *s == '_') {
-           /* skip underscores, checking for misplaced ones 
+           /* skip underscores, checking for misplaced ones
               if -w is on
            */
            if (*s == '_') {
               if -w is on
            */
            if (*s == '_') {
-               dTHR;                   /* only for ckWARN */
                if (ckWARN(WARN_SYNTAX) && lastub && s - lastub != 3)
                    Perl_warner(aTHX_ WARN_SYNTAX, "Misplaced _ in number");
                lastub = ++s;
                if (ckWARN(WARN_SYNTAX) && lastub && s - lastub != 3)
                    Perl_warner(aTHX_ WARN_SYNTAX, "Misplaced _ in number");
                lastub = ++s;
@@ -6986,7 +7095,6 @@ Perl_scan_num(pTHX_ char *start, YYSTYPE* lvalp)
 
        /* final misplaced underbar check */
        if (lastub && s - lastub != 3) {
 
        /* final misplaced underbar check */
        if (lastub && s - lastub != 3) {
-           dTHR;
            if (ckWARN(WARN_SYNTAX))
                Perl_warner(aTHX_ WARN_SYNTAX, "Misplaced _ in number");
        }
            if (ckWARN(WARN_SYNTAX))
                Perl_warner(aTHX_ WARN_SYNTAX, "Misplaced _ in number");
        }
@@ -7095,7 +7203,7 @@ Perl_scan_num(pTHX_ char *start, YYSTYPE* lvalp)
           compilers have issues.  Then we try casting it back and see
           if it was the same [1].  We only do this if we know we
           specifically read an integer.  If floatit is true, then we
           compilers have issues.  Then we try casting it back and see
           if it was the same [1].  We only do this if we know we
           specifically read an integer.  If floatit is true, then we
-          don't need to do the conversion at all. 
+          don't need to do the conversion at all.
 
           [1] Note that this is lossy if our NVs cannot preserve our
           UVs.  There are metaconfig defines NV_PRESERVES_UV (a boolean)
 
           [1] Note that this is lossy if our NVs cannot preserve our
           UVs.  There are metaconfig defines NV_PRESERVES_UV (a boolean)
@@ -7106,7 +7214,7 @@ Perl_scan_num(pTHX_ char *start, YYSTYPE* lvalp)
           Maybe could do some tricks with DBL_DIG, LDBL_DIG and
           DBL_MANT_DIG and LDBL_MANT_DIG (these are already available
           as NV_DIG and NV_MANT_DIG)?
           Maybe could do some tricks with DBL_DIG, LDBL_DIG and
           DBL_MANT_DIG and LDBL_MANT_DIG (these are already available
           as NV_DIG and NV_MANT_DIG)?
-          
+       
           --jhi
           */
        {
           --jhi
           */
        {
@@ -7123,7 +7231,7 @@ Perl_scan_num(pTHX_ char *start, YYSTYPE* lvalp)
 #endif
        if ( floatit ? (PL_hints & HINT_NEW_FLOAT) :
                       (PL_hints & HINT_NEW_INTEGER) )
 #endif
        if ( floatit ? (PL_hints & HINT_NEW_FLOAT) :
                       (PL_hints & HINT_NEW_INTEGER) )
-           sv = new_constant(PL_tokenbuf, d - PL_tokenbuf, 
+           sv = new_constant(PL_tokenbuf, d - PL_tokenbuf,
                              (floatit ? "float" : "integer"),
                              sv, Nullsv, NULL);
        break;
                              (floatit ? "float" : "integer"),
                              sv, Nullsv, NULL);
        break;
@@ -7137,10 +7245,9 @@ vstring:
            while (isDIGIT(*pos) || *pos == '_')
                pos++;
            if (!isALPHA(*pos)) {
            while (isDIGIT(*pos) || *pos == '_')
                pos++;
            if (!isALPHA(*pos)) {
-               UV rev;
-               U8 tmpbuf[UTF8_MAXLEN];
+               UV rev, revmax = 0;
+               U8 tmpbuf[UTF8_MAXLEN+1];
                U8 *tmpend;
                U8 *tmpend;
-               bool utf8 = FALSE;
                s++;                            /* get past 'v' */
 
                sv = NEWSV(92,5);
                s++;                            /* get past 'v' */
 
                sv = NEWSV(92,5);
@@ -7167,7 +7274,8 @@ vstring:
                        }
                    }
                    tmpend = uv_to_utf8(tmpbuf, rev);
                        }
                    }
                    tmpend = uv_to_utf8(tmpbuf, rev);
-                   utf8 = utf8 || rev > 127;
+                   if (rev > revmax)
+                       revmax = rev;
                    sv_catpvn(sv, (const char*)tmpbuf, tmpend - tmpbuf);
                    if (*pos == '.' && isDIGIT(pos[1]))
                        s = ++pos;
                    sv_catpvn(sv, (const char*)tmpbuf, tmpend - tmpbuf);
                    if (*pos == '.' && isDIGIT(pos[1]))
                        s = ++pos;
@@ -7181,9 +7289,10 @@ vstring:
 
                SvPOK_on(sv);
                SvREADONLY_on(sv);
 
                SvPOK_on(sv);
                SvREADONLY_on(sv);
-               if (utf8) {
+               if (revmax > 127) {
                    SvUTF8_on(sv);
                    SvUTF8_on(sv);
-                   sv_utf8_downgrade(sv, TRUE);
+                   if (revmax < 256)
+                     sv_utf8_downgrade(sv, TRUE);
                }
            }
        }
                }
            }
        }
@@ -7203,7 +7312,6 @@ vstring:
 STATIC char *
 S_scan_formline(pTHX_ register char *s)
 {
 STATIC char *
 S_scan_formline(pTHX_ register char *s)
 {
-    dTHR;
     register char *eol;
     register char *t;
     SV *stuff = newSVpvn("",0);
     register char *eol;
     register char *t;
     SV *stuff = newSVpvn("",0);
@@ -7251,6 +7359,7 @@ S_scan_formline(pTHX_ register char *s)
            s = filter_gets(PL_linestr, PL_rsfp, 0);
            PL_oldoldbufptr = PL_oldbufptr = PL_bufptr = PL_linestart = SvPVX(PL_linestr);
            PL_bufend = PL_bufptr + SvCUR(PL_linestr);
            s = filter_gets(PL_linestr, PL_rsfp, 0);
            PL_oldoldbufptr = PL_oldbufptr = PL_bufptr = PL_linestart = SvPVX(PL_linestr);
            PL_bufend = PL_bufptr + SvCUR(PL_linestr);
+           PL_last_lop = PL_last_uni = Nullch;
            if (!s) {
                s = PL_bufptr;
                yyerror("Format not terminated");
            if (!s) {
                s = PL_bufptr;
                yyerror("Format not terminated");
@@ -7294,7 +7403,6 @@ S_set_csh(pTHX)
 I32
 Perl_start_subparse(pTHX_ I32 is_format, U32 flags)
 {
 I32
 Perl_start_subparse(pTHX_ I32 is_format, U32 flags)
 {
-    dTHR;
     I32 oldsavestack_ix = PL_savestack_ix;
     CV* outsidecv = PL_compcv;
     AV* comppadlist;
     I32 oldsavestack_ix = PL_savestack_ix;
     CV* outsidecv = PL_compcv;
     AV* comppadlist;
@@ -7347,10 +7455,12 @@ Perl_start_subparse(pTHX_ I32 is_format, U32 flags)
     return oldsavestack_ix;
 }
 
     return oldsavestack_ix;
 }
 
+#ifdef __SC__
+#pragma segment Perl_yylex
+#endif
 int
 Perl_yywarn(pTHX_ char *s)
 {
 int
 Perl_yywarn(pTHX_ char *s)
 {
-    dTHR;
     PL_in_eval |= EVAL_WARNONLY;
     yyerror(s);
     PL_in_eval &= ~EVAL_WARNONLY;
     PL_in_eval |= EVAL_WARNONLY;
     yyerror(s);
     PL_in_eval &= ~EVAL_WARNONLY;
@@ -7360,7 +7470,6 @@ Perl_yywarn(pTHX_ char *s)
 int
 Perl_yyerror(pTHX_ char *s)
 {
 int
 Perl_yyerror(pTHX_ char *s)
 {
-    dTHR;
     char *where = NULL;
     char *context = NULL;
     int contlen = -1;
     char *where = NULL;
     char *context = NULL;
     int contlen = -1;
@@ -7437,6 +7546,9 @@ Perl_yyerror(pTHX_ char *s)
     PL_in_my_stash = Nullhv;
     return 0;
 }
     PL_in_my_stash = Nullhv;
     return 0;
 }
+#ifdef __SC__
+#pragma segment Main
+#endif
 
 STATIC char*
 S_swallow_bom(pTHX_ U8 *s)
 
 STATIC char*
 S_swallow_bom(pTHX_ U8 *s)
@@ -7444,8 +7556,8 @@ S_swallow_bom(pTHX_ U8 *s)
     STRLEN slen;
     slen = SvCUR(PL_linestr);
     switch (*s) {
     STRLEN slen;
     slen = SvCUR(PL_linestr);
     switch (*s) {
-    case 0xFF:       
-       if (s[1] == 0xFE) { 
+    case 0xFF:
+       if (s[1] == 0xFE) {
            /* UTF-16 little-endian */
            if (s[2] == 0 && s[3] == 0)  /* UTF-32 little-endian */
                Perl_croak(aTHX_ "Unsupported script encoding");
            /* UTF-16 little-endian */
            if (s[2] == 0 && s[3] == 0)  /* UTF-32 little-endian */
                Perl_croak(aTHX_ "Unsupported script encoding");
@@ -7547,7 +7659,7 @@ utf16_textfilter(pTHXo_ int idx, SV *sv, int maxlen)
        if (!*SvPV_nolen(sv))
        /* Game over, but don't feed an odd-length string to utf16_to_utf8 */
        return count;
        if (!*SvPV_nolen(sv))
        /* Game over, but don't feed an odd-length string to utf16_to_utf8 */
        return count;
-       
+
        tend = utf16_to_utf8((U8*)SvPVX(sv), tmps, SvCUR(sv), &newlen);
        sv_usepvn(sv, (char*)tmps, tend - tmps);
     }
        tend = utf16_to_utf8((U8*)SvPVX(sv), tmps, SvCUR(sv), &newlen);
        sv_usepvn(sv, (char*)tmps, tend - tmps);
     }
Unnamed repository; edit this file 'description' to name the repository.