Convert the last remaining 256 byte "small"bufs to 128 bytes.
[p5sagit/p5-mst-13.2.git] / toke.c
diff --git a/toke.c b/toke.c
index 9b48f96..d3c7be6 100644 (file)
--- a/toke.c
+++ b/toke.c
@@ -1,7 +1,7 @@
 /*    toke.c
  *
  *    Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999,
- *    2000, 2001, 2002, 2003, 2004, 2005, 2006, by Larry Wall and others
+ *    2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, by Larry Wall and others
  *
  *    You may distribute under the terms of either the GNU General Public
  *    License or the Artistic License, as specified in the README file.
 #define PERL_IN_TOKE_C
 #include "perl.h"
 
-#define yychar (*PL_yycharp)
-#define yylval (*PL_yylvalp)
+#define yylval (PL_parser->yylval)
+
+/* YYINITDEPTH -- initial size of the parser's stacks.  */
+#define YYINITDEPTH 200
+
+/* XXX temporary backwards compatibility */
+#define PL_lex_brackets                (PL_parser->lex_brackets)
+#define PL_lex_brackstack      (PL_parser->lex_brackstack)
+#define PL_lex_casemods                (PL_parser->lex_casemods)
+#define PL_lex_casestack        (PL_parser->lex_casestack)
+#define PL_lex_defer           (PL_parser->lex_defer)
+#define PL_lex_dojoin          (PL_parser->lex_dojoin)
+#define PL_lex_expect          (PL_parser->lex_expect)
+#define PL_lex_formbrack        (PL_parser->lex_formbrack)
+#define PL_lex_inpat           (PL_parser->lex_inpat)
+#define PL_lex_inwhat          (PL_parser->lex_inwhat)
+#define PL_lex_op              (PL_parser->lex_op)
+#define PL_lex_repl            (PL_parser->lex_repl)
+#define PL_lex_starts          (PL_parser->lex_starts)
+#define PL_lex_stuff           (PL_parser->lex_stuff)
+#define PL_multi_start         (PL_parser->multi_start)
+#define PL_multi_open          (PL_parser->multi_open)
+#define PL_multi_close         (PL_parser->multi_close)
+#define PL_pending_ident        (PL_parser->pending_ident)
+#define PL_preambled           (PL_parser->preambled)
+#define PL_sublex_info         (PL_parser->sublex_info)
+
+#ifdef PERL_MAD
+#  define PL_endwhite          (PL_parser->endwhite)
+#  define PL_faketokens                (PL_parser->faketokens)
+#  define PL_lasttoke          (PL_parser->lasttoke)
+#  define PL_nextwhite         (PL_parser->nextwhite)
+#  define PL_realtokenstart    (PL_parser->realtokenstart)
+#  define PL_skipwhite         (PL_parser->skipwhite)
+#  define PL_thisclose         (PL_parser->thisclose)
+#  define PL_thismad           (PL_parser->thismad)
+#  define PL_thisopen          (PL_parser->thisopen)
+#  define PL_thisstuff         (PL_parser->thisstuff)
+#  define PL_thistoken         (PL_parser->thistoken)
+#  define PL_thiswhite         (PL_parser->thiswhite)
+#endif
+
+static int
+S_pending_ident(pTHX);
 
 static const char ident_too_long[] = "Identifier too long";
 static const char commaless_variable_list[] = "comma-less variable list";
@@ -569,6 +611,8 @@ S_cr_textfilter(pTHX_ int idx, SV *sv, int maxlen)
 }
 #endif
 
+
+
 /*
  * Perl_lex_start
  * Initialize variables.  Uses the Perl save_stack to save its state (for
@@ -579,37 +623,36 @@ void
 Perl_lex_start(pTHX_ SV *line)
 {
     dVAR;
-    const char *s;
+    const char *s = NULL;
     STRLEN len;
+    yy_parser *parser;
+
+    /* create and initialise a parser */
+
+    Newxz(parser, 1, yy_parser);
+    parser->old_parser = PL_parser;
+    PL_parser = parser;
+
+    Newx(parser->stack, YYINITDEPTH, yy_stack_frame);
+    parser->ps = parser->stack;
+    parser->stack_size = YYINITDEPTH;
+
+    parser->stack->state = 0;
+    parser->yyerrstatus = 0;
+    parser->yychar = YYEMPTY;          /* Cause a token to be read.  */
+
+    /* initialise lexer state */
 
-    SAVEI32(PL_lex_dojoin);
-    SAVEI32(PL_lex_brackets);
-    SAVEI32(PL_lex_casemods);
-    SAVEI32(PL_lex_starts);
     SAVEI32(PL_lex_state);
-    SAVEVPTR(PL_lex_inpat);
-    SAVEI32(PL_lex_inwhat);
 #ifdef PERL_MAD
     if (PL_lex_state == LEX_KNOWNEXT) {
-       I32 toke = PL_lasttoke;
+       I32 toke = parser->old_parser->lasttoke;
        while (--toke >= 0) {
            SAVEI32(PL_nexttoke[toke].next_type);
            SAVEVPTR(PL_nexttoke[toke].next_val);
            if (PL_madskills)
                SAVEVPTR(PL_nexttoke[toke].next_mad);
        }
-       SAVEI32(PL_lasttoke);
-    }
-    if (PL_madskills) {
-       SAVESPTR(PL_thistoken);
-       SAVESPTR(PL_thiswhite);
-       SAVESPTR(PL_nextwhite);
-       SAVESPTR(PL_thisopen);
-       SAVESPTR(PL_thisclose);
-       SAVESPTR(PL_thisstuff);
-       SAVEVPTR(PL_thismad);
-       SAVEI32(PL_realtokenstart);
-       SAVEI32(PL_faketokens);
     }
     SAVEI32(PL_curforce);
 #else
@@ -631,44 +674,37 @@ Perl_lex_start(pTHX_ SV *line)
     SAVEPPTR(PL_last_uni);
     SAVEPPTR(PL_linestart);
     SAVESPTR(PL_linestr);
-    SAVEGENERICPV(PL_lex_brackstack);
-    SAVEGENERICPV(PL_lex_casestack);
     SAVEDESTRUCTOR_X(restore_rsfp, PL_rsfp);
-    SAVESPTR(PL_lex_stuff);
-    SAVEI32(PL_lex_defer);
-    SAVEI32(PL_sublex_info.sub_inwhat);
-    SAVESPTR(PL_lex_repl);
     SAVEINT(PL_expect);
-    SAVEINT(PL_lex_expect);
 
     PL_lex_state = LEX_NORMAL;
-    PL_lex_defer = 0;
     PL_expect = XSTATE;
-    PL_lex_brackets = 0;
-    Newx(PL_lex_brackstack, 120, char);
-    Newx(PL_lex_casestack, 12, char);
-    PL_lex_casemods = 0;
-    *PL_lex_casestack = '\0';
-    PL_lex_dojoin = 0;
-    PL_lex_starts = 0;
-    PL_lex_stuff = NULL;
-    PL_lex_repl = NULL;
-    PL_lex_inpat = 0;
-#ifdef PERL_MAD
-    PL_lasttoke = 0;
-#else
+    Newx(parser->lex_brackstack, 120, char);
+    Newx(parser->lex_casestack, 12, char);
+    *parser->lex_casestack = '\0';
+#ifndef PERL_MAD
     PL_nexttoke = 0;
 #endif
-    PL_lex_inwhat = 0;
-    PL_sublex_info.sub_inwhat = 0;
-    PL_linestr = line;
-    s = SvPV_const(PL_linestr, len);
-    if (SvREADONLY(PL_linestr) || !len || s[len-1] != ';') {
-       PL_linestr = sv_2mortal(len ? newSVsv(PL_linestr) : newSVpvn(s, 0));
-       if (!len || s[len-1] != ';')
+
+    if (line) {
+       s = SvPV_const(line, len);
+    } else {
+       len = 0;
+    }
+    if (!len) {
+       PL_linestr = newSVpvs("\n;");
+    } else if (SvREADONLY(line) || s[len-1] != ';') {
+       PL_linestr = newSVsv(line);
+       if (s[len-1] != ';')
            sv_catpvs(PL_linestr, "\n;");
+    } else {
+       SvTEMP_off(line);
+       SvREFCNT_inc_simple_void_NN(line);
+       PL_linestr = line;
     }
-    SvTEMP_off(PL_linestr);
+    /* PL_linestr needs to survive until end of scope, not just the next
+       FREETMPS. See changes 17505 and 17546 which fixed the symptoms only.  */
+    SAVEFREESV(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 = NULL;
@@ -754,32 +790,33 @@ S_incline(pTHX_ char *s)
        if (tmplen > 7 && strnEQ(cf, "(eval ", 6)) {
            /* must copy *{"::_<(eval N)[oldfilename:L]"}
             * to *{"::_<newfilename"} */
-           char smallbuf[256], smallbuf2[256];
+           char smallbuf[128], smallbuf2[128];
            char *tmpbuf, *tmpbuf2;
            GV **gvp, *gv2;
            STRLEN tmplen2 = strlen(s);
-           if (tmplen + 3 < sizeof smallbuf)
+           if (tmplen + 2 < sizeof smallbuf)
                tmpbuf = smallbuf;
            else
-               Newx(tmpbuf, tmplen + 3, char);
-           if (tmplen2 + 3 < sizeof smallbuf2)
+               Newx(tmpbuf, tmplen + 2, char);
+           if (tmplen2 + 2 < sizeof smallbuf2)
                tmpbuf2 = smallbuf2;
            else
-               Newx(tmpbuf2, tmplen2 + 3, char);
+               Newx(tmpbuf2, tmplen2 + 2, char);
            tmpbuf[0] = tmpbuf2[0] = '_';
            tmpbuf[1] = tmpbuf2[1] = '<';
-           memcpy(tmpbuf + 2, cf, ++tmplen);
-           memcpy(tmpbuf2 + 2, s, ++tmplen2);
-           ++tmplen; ++tmplen2;
+           memcpy(tmpbuf + 2, cf, tmplen);
+           memcpy(tmpbuf2 + 2, s, tmplen2);
+           tmplen += 2; tmplen2 += 2;
            gvp = (GV**)hv_fetch(PL_defstash, tmpbuf, tmplen, FALSE);
            if (gvp) {
                gv2 = *(GV**)hv_fetch(PL_defstash, tmpbuf2, tmplen2, TRUE);
-               if (!isGV(gv2))
+               if (!isGV(gv2)) {
                    gv_init(gv2, PL_defstash, tmpbuf2, tmplen2, FALSE);
-               /* adjust ${"::_<newfilename"} to store the new file name */
-               GvSV(gv2) = newSVpvn(tmpbuf2 + 2, tmplen2 - 2);
-               GvHV(gv2) = (HV*)SvREFCNT_inc(GvHV(*gvp));
-               GvAV(gv2) = (AV*)SvREFCNT_inc(GvAV(*gvp));
+                   /* adjust ${"::_<newfilename"} to store the new file name */
+                   GvSV(gv2) = newSVpvn(tmpbuf2 + 2, tmplen2 - 2);
+                   GvHV(gv2) = (HV*)SvREFCNT_inc(GvHV(*gvp));
+                   GvAV(gv2) = (AV*)SvREFCNT_inc(GvAV(*gvp));
+               }
            }
            if (tmpbuf != smallbuf) Safefree(tmpbuf);
            if (tmpbuf2 != smallbuf2) Safefree(tmpbuf2);
@@ -868,6 +905,23 @@ S_skipspace2(pTHX_ register char *s, SV **svp)
 }
 #endif
 
+STATIC void
+S_update_debugger_info(pTHX_ SV *orig_sv, const char *buf, STRLEN len)
+{
+    AV *av = CopFILEAVx(PL_curcop);
+    if (av) {
+       SV * const sv = newSV(0);
+       sv_upgrade(sv, SVt_PVMG);
+       if (orig_sv)
+           sv_setsv(sv, orig_sv);
+       else
+           sv_setpvn(sv, buf, len);
+       (void)SvIOK_on(sv);
+       SvIV_set(sv, 0);
+       av_store(av, (I32)CopLINE(PL_curcop), sv);
+    }
+}
+
 /*
  * S_skipspace
  * Called to gobble the appropriate amount and type of whitespace.
@@ -1031,15 +1085,8 @@ S_skipspace(pTHX_ register char *s)
        /* debugger active and we're not compiling the debugger code,
         * so store the line into the debugger's array of lines
         */
-       if (PERLDB_LINE && PL_curstash != PL_debstash) {
-           SV * const sv = newSV(0);
-
-           sv_upgrade(sv, SVt_PVMG);
-           sv_setpvn(sv,PL_bufptr,PL_bufend-PL_bufptr);
-            (void)SvIOK_on(sv);
-            SvIV_set(sv, 0);
-           av_store(CopFILEAVx(PL_curcop),(I32)CopLINE(PL_curcop),sv);
-       }
+       if (PERLDB_LINE && PL_curstash != PL_debstash)
+           update_debugger_info(NULL, PL_bufptr, PL_bufend - PL_bufptr);
     }
 
 #ifdef PERL_MAD
@@ -1247,11 +1294,12 @@ S_newSV_maybe_utf8(pTHX_ const char *start, STRLEN len)
  * S_force_word
  * When the lexer knows the next thing is a word (for instance, it has
  * just seen -> and it knows that the next char is a word char, then
- * it calls S_force_word to stick the next word into the PL_next lookahead.
+ * it calls S_force_word to stick the next word into the PL_nexttoke/val
+ * lookahead.
  *
  * Arguments:
  *   char *start : buffer position (must be within PL_linestr)
- *   int token   : PL_next will be this type of bare word (e.g., METHOD,WORD)
+ *   int token   : PL_next* will be this type of bare word (e.g., METHOD,WORD)
  *   int check_keyword : if true, Perl checks to make sure the word isn't
  *       a keyword (do this if the word is a label, e.g. goto FOO)
  *   int allow_pack : if true, : characters will also be allowed (require,
@@ -2611,7 +2659,7 @@ S_intuit_method(pTHX_ char *start, GV *gv, CV *cv)
        if (indirgv && GvCVu(indirgv))
            return 0;
        /* filehandle or package name makes it a method */
-       if (!gv || GvIO(indirgv) || gv_stashpvn(tmpbuf, len, FALSE)) {
+       if (!gv || GvIO(indirgv) || gv_stashpvn(tmpbuf, len, 0)) {
 #ifdef PERL_MAD
            soff = s - SvPVX(PL_linestr);
 #endif
@@ -2843,7 +2891,7 @@ S_find_in_my_stash(pTHX_ const char *pkgname, I32 len)
             pkgname = SvPV_nolen_const(sv);
     }
 
-    return gv_stashpv(pkgname, FALSE);
+    return gv_stashpv(pkgname, 0);
 }
 
 /*
@@ -3544,15 +3592,8 @@ Perl_yylex(pTHX)
            PL_oldoldbufptr = PL_oldbufptr = s = PL_linestart = SvPVX(PL_linestr);
            PL_bufend = SvPVX(PL_linestr) + SvCUR(PL_linestr);
            PL_last_lop = PL_last_uni = NULL;
-           if (PERLDB_LINE && PL_curstash != PL_debstash) {
-               SV * const sv = newSV(0);
-
-               sv_upgrade(sv, SVt_PVMG);
-               sv_setsv(sv,PL_linestr);
-                (void)SvIOK_on(sv);
-                SvIV_set(sv, 0);
-               av_store(CopFILEAVx(PL_curcop),(I32)CopLINE(PL_curcop),sv);
-           }
+           if (PERLDB_LINE && PL_curstash != PL_debstash)
+               update_debugger_info(PL_linestr, NULL, 0);
            goto retry;
        }
        do {
@@ -3633,7 +3674,7 @@ Perl_yylex(pTHX)
                if (PL_madskills)
                    sv_catsv(PL_thiswhite, PL_linestr);
 #endif
-               if (*s == '=' && strnEQ(s, "=cut", 4)) {
+               if (*s == '=' && strnEQ(s, "=cut", 4) && !isALPHA(s[4])) {
                    sv_setpvn(PL_linestr, "", 0);
                    PL_oldoldbufptr = PL_oldbufptr = s = PL_linestart = SvPVX(PL_linestr);
                    PL_bufend = SvPVX(PL_linestr) + SvCUR(PL_linestr);
@@ -3644,15 +3685,8 @@ Perl_yylex(pTHX)
            incline(s);
        } while (PL_doextract);
        PL_oldoldbufptr = PL_oldbufptr = PL_bufptr = PL_linestart = s;
-       if (PERLDB_LINE && PL_curstash != PL_debstash) {
-           SV * const sv = newSV(0);
-
-           sv_upgrade(sv, SVt_PVMG);
-           sv_setsv(sv,PL_linestr);
-            (void)SvIOK_on(sv);
-            SvIV_set(sv, 0);
-           av_store(CopFILEAVx(PL_curcop),(I32)CopLINE(PL_curcop),sv);
-       }
+       if (PERLDB_LINE && PL_curstash != PL_debstash)
+           update_debugger_info(PL_linestr, NULL, 0);
        PL_bufend = SvPVX(PL_linestr) + SvCUR(PL_linestr);
        PL_last_lop = PL_last_uni = NULL;
        if (CopLINE(PL_curcop) == 1) {
@@ -4100,8 +4134,7 @@ Perl_yylex(pTHX)
        /* FALL THROUGH */
     case '~':
        if (s[1] == '~'
-       && (PL_expect == XOPERATOR || PL_expect == XTERMORDORDOR)
-       && FEATURE_IS_ENABLED("~~"))
+           && (PL_expect == XOPERATOR || PL_expect == XTERMORDORDOR))
        {
            s += 2;
            Eop(OP_SMARTMATCH);
@@ -4761,12 +4794,12 @@ Perl_yylex(pTHX)
                                t++;
                            } while (isSPACE(*t));
                            if (isIDFIRST_lazy_if(t,UTF)) {
-                               STRLEN dummylen;
+                               STRLEN len;
                                t = scan_word(t, tmpbuf, sizeof tmpbuf, TRUE,
-                                             &dummylen);
+                                             &len);
                                while (isSPACE(*t))
                                    t++;
-                               if (*t == ';' && get_cv(tmpbuf, FALSE))
+                               if (*t == ';' && get_cvn_flags(tmpbuf, len, 0))
                                    Perl_warner(aTHX_ packWARN(WARN_SYNTAX),
                                                "You need to quote \"%s\"",
                                                tmpbuf);
@@ -5086,7 +5119,7 @@ Perl_yylex(pTHX)
        if (!tmp && PL_expect == XSTATE
              && d < PL_bufend && *d == ':' && *(d + 1) != ':') {
            s = d + 1;
-           yylval.pval = savepv(PL_tokenbuf);
+           yylval.pval = CopLABEL_alloc(PL_tokenbuf);
            CLINE;
            TOKEN(LABEL);
        }
@@ -5523,7 +5556,7 @@ Perl_yylex(pTHX)
                            d = PL_tokenbuf;
                            while (isLOWER(*d))
                                d++;
-                           if (!*d && !gv_stashpv(PL_tokenbuf,FALSE))
+                           if (!*d && !gv_stashpv(PL_tokenbuf, 0))
                                Perl_warner(aTHX_ packWARN(WARN_RESERVED), PL_warn_reserved,
                                       PL_tokenbuf);
                        }
@@ -5634,7 +5667,7 @@ Perl_yylex(pTHX)
                        PUTBACK;
                        PerlIO_apply_layers(aTHX_ PL_rsfp, NULL,
                                            Perl_form(aTHX_ ":encoding(%"SVf")",
-                                                     (void*)name));
+                                                     SVfARG(name)));
                        FREETMPS;
                        LEAVE;
                    }
@@ -6321,7 +6354,7 @@ Perl_yylex(pTHX)
                *PL_tokenbuf = '\0';
                s = force_word(s,WORD,TRUE,TRUE,FALSE);
                if (isIDFIRST_lazy_if(PL_tokenbuf,UTF))
-                   gv_stashpvn(PL_tokenbuf, strlen(PL_tokenbuf), TRUE);
+                   gv_stashpvn(PL_tokenbuf, strlen(PL_tokenbuf), GV_ADD);
                else if (*s == '<')
                    yyerror("<> should be quotes");
            }
@@ -6621,7 +6654,7 @@ Perl_yylex(pTHX)
                    if (bad_proto)
                        Perl_warner(aTHX_ packWARN(WARN_SYNTAX),
                                    "Illegal character in prototype for %"SVf" : %s",
-                                   (void*)PL_subname, d);
+                                   SVfARG(PL_subname), d);
                    SvCUR_set(PL_lex_stuff, tmp);
                    have_proto = TRUE;
 
@@ -6650,7 +6683,7 @@ Perl_yylex(pTHX)
                    if (!have_name)
                        Perl_croak(aTHX_ "Illegal declaration of anonymous subroutine");
                    else if (*s != ';')
-                       Perl_croak(aTHX_ "Illegal declaration of subroutine %"SVf, (void*)PL_subname);
+                       Perl_croak(aTHX_ "Illegal declaration of subroutine %"SVf, SVfARG(PL_subname));
                }
 
 #ifdef PERL_MAD
@@ -10704,7 +10737,8 @@ S_scan_ident(pTHX_ register char *s, register const char *send, char *dest, STRL
            }
            if (PL_lex_state == LEX_NORMAL) {
                if (ckWARN(WARN_AMBIGUOUS) &&
-                   (keyword(dest, d - dest, 0) || get_cv(dest, FALSE)))
+                   (keyword(dest, d - dest, 0)
+                    || get_cvn_flags(dest, d - dest, 0)))
                {
                    if (funny == '#')
                        funny = '@';
@@ -10728,20 +10762,16 @@ void
 Perl_pmflag(pTHX_ U32* pmfl, int ch)
 {
     PERL_UNUSED_CONTEXT;
-    if (ch == 'i')
-       *pmfl |= PMf_FOLD;
-    else if (ch == 'g')
-       *pmfl |= PMf_GLOBAL;
-    else if (ch == 'c')
-       *pmfl |= PMf_CONTINUE;
-    else if (ch == 'o')
-       *pmfl |= PMf_KEEP;
-    else if (ch == 'm')
-       *pmfl |= PMf_MULTILINE;
-    else if (ch == 's')
-       *pmfl |= PMf_SINGLELINE;
-    else if (ch == 'x')
-       *pmfl |= PMf_EXTENDED;
+    if (ch<256) {
+        char c = (char)ch;
+        switch (c) {
+            CASE_STD_PMMOD_FLAGS_PARSE_SET(pmfl);
+            case GLOBAL_PAT_MOD:    *pmfl |= PMf_GLOBAL; break;
+            case CONTINUE_PAT_MOD:  *pmfl |= PMf_CONTINUE; break;
+            case ONCE_PAT_MOD:      *pmfl |= PMf_KEEP; break;
+            case KEEPCOPY_PAT_MOD:  *pmfl |= PMf_KEEPCOPY; break;
+        }
+    }
 }
 
 STATIC char *
@@ -10751,7 +10781,7 @@ S_scan_pat(pTHX_ char *start, I32 type)
     PMOP *pm;
     char *s = scan_str(start,!!PL_madskills,FALSE);
     const char * const valid_flags =
-       (const char *)((type == OP_QR) ? "iomsx" : "iogcmsx");
+       (const char *)((type == OP_QR) ? QR_PAT_MODS : M_PAT_MODS);
 #ifdef PERL_MAD
     char *modstart;
 #endif
@@ -10784,7 +10814,8 @@ S_scan_pat(pTHX_ char *start, I32 type)
     if ((pm->op_pmflags & PMf_CONTINUE) && !(pm->op_pmflags & PMf_GLOBAL)
            && ckWARN(WARN_REGEXP))
     {
-        Perl_warner(aTHX_ packWARN(WARN_REGEXP), "Use of /c modifier is meaningless without /g" );
+        Perl_warner(aTHX_ packWARN(WARN_REGEXP), 
+            "Use of /c modifier is meaningless without /g" );
     }
 
     pm->op_pmpermflags = pm->op_pmflags;
@@ -10848,11 +10879,11 @@ S_scan_subst(pTHX_ char *start)
 #endif
 
     while (*s) {
-       if (*s == 'e') {
+       if (*s == EXEC_PAT_MOD) {
            s++;
            es++;
        }
-       else if (strchr("iogcmsx", *s))
+       else if (strchr(S_PAT_MODS, *s))
            pmflag(&pm->op_pmflags,*s++);
        else
            break;
@@ -10963,7 +10994,7 @@ S_scan_trans(pTHX_ char *start)
     }
   no_more:
 
-    Newx(tbl, complement&&!del?258:256, short);
+    tbl = (short *)PerlMemShared_calloc(complement&&!del?258:256, sizeof(short));
     o = newPVOP(OP_TRANS, 0, (char*)tbl);
     o->op_private &= ~OPpTRANS_ALL;
     o->op_private |= del|squash|complement|
@@ -11214,15 +11245,8 @@ S_scan_heredoc(pTHX_ register char *s)
        else if (PL_bufend - PL_linestart == 1 && PL_bufend[-1] == '\r')
            PL_bufend[-1] = '\n';
 #endif
-       if (PERLDB_LINE && PL_curstash != PL_debstash) {
-           SV * const sv = newSV(0);
-
-           sv_upgrade(sv, SVt_PVMG);
-           sv_setsv(sv,PL_linestr);
-            (void)SvIOK_on(sv);
-            SvIV_set(sv, 0);
-           av_store(CopFILEAVx(PL_curcop), (I32)CopLINE(PL_curcop),sv);
-       }
+       if (PERLDB_LINE && PL_curstash != PL_debstash)
+           update_debugger_info(PL_linestr, NULL, 0);
        if (*s == term && memEQ(s,PL_tokenbuf,len)) {
            STRLEN off = PL_bufend - 1 - SvPVX_const(PL_linestr);
            *(SvPVX(PL_linestr) + off ) = ' ';
@@ -11471,7 +11495,7 @@ S_scan_str(pTHX_ char *start, int keep_quoted, int keep_delims)
     I32 termcode;                      /* terminating char. code */
     U8 termstr[UTF8_MAXBYTES];         /* terminating string */
     STRLEN termlen;                    /* length of terminating string */
-    char *last = NULL;                 /* last position for nesting bracket */
+    int last_off = 0;                  /* last position for nesting bracket */
 #ifdef PERL_MAD
     int stuffstart;
     char *tstart;
@@ -11572,9 +11596,7 @@ S_scan_str(pTHX_ char *start, int keep_quoted, int keep_delims)
                    else {
                        const char *t;
                        char *w;
-                       if (!last)
-                           last = SvPVX(sv);
-                       for (t = w = last; t < svlast; w++, t++) {
+                       for (t = w = SvPVX(sv)+last_off; t < svlast; w++, t++) {
                            /* At here, all closes are "was quoted" one,
                               so we don't check PL_multi_close. */
                            if (*t == '\\') {
@@ -11593,7 +11615,7 @@ S_scan_str(pTHX_ char *start, int keep_quoted, int keep_delims)
                            *w = '\0';
                            SvCUR_set(sv, w - SvPVX_const(sv));
                        }
-                       last = w;
+                       last_off = w - SvPVX(sv);
                        if (--brackets <= 0)
                            cont = FALSE;
                    }
@@ -11720,15 +11742,8 @@ S_scan_str(pTHX_ char *start, int keep_quoted, int keep_delims)
        CopLINE_inc(PL_curcop);
 
        /* update debugger info */
-       if (PERLDB_LINE && PL_curstash != PL_debstash) {
-           SV * const line_sv = newSV(0);
-
-           sv_upgrade(line_sv, SVt_PVMG);
-           sv_setsv(line_sv,PL_linestr);
-           (void)SvIOK_on(line_sv);
-           SvIV_set(line_sv, 0);
-           av_store(CopFILEAVx(PL_curcop), (I32)CopLINE(PL_curcop), line_sv);
-       }
+       if (PERLDB_LINE && PL_curstash != PL_debstash)
+           update_debugger_info(PL_linestr, NULL, 0);
 
        /* having changed the buffer, we must update PL_bufend */
        PL_bufend = SvPVX(PL_linestr) + SvCUR(PL_linestr);
@@ -11741,7 +11756,7 @@ S_scan_str(pTHX_ char *start, int keep_quoted, int keep_delims)
 #ifdef PERL_MAD
        if (PL_madskills) {
            char * const tstart = SvPVX(PL_linestr) + stuffstart;
-           const int len = s - start;
+           const int len = s - tstart;
            if (PL_thisstuff)
                sv_catpvn(PL_thisstuff, tstart, len);
            else
@@ -12389,6 +12404,7 @@ Perl_yyerror(pTHX_ const char *s)
     const char *context = NULL;
     int contlen = -1;
     SV *msg;
+    int yychar  = PL_parser->yychar;
 
     if (!yychar || (yychar == ';' && !PL_rsfp))
        where = "at EOF";
@@ -12460,13 +12476,13 @@ Perl_yyerror(pTHX_ const char *s)
         PL_multi_end = 0;
     }
     if (PL_in_eval & EVAL_WARNONLY && ckWARN_d(WARN_SYNTAX))
-       Perl_warner(aTHX_ packWARN(WARN_SYNTAX), "%"SVf, (void*)msg);
+       Perl_warner(aTHX_ packWARN(WARN_SYNTAX), "%"SVf, SVfARG(msg));
     else
        qerror(msg);
     if (PL_error_count >= 10) {
        if (PL_in_eval && SvCUR(ERRSV))
            Perl_croak(aTHX_ "%"SVf"%s has too many errors.\n",
-                      (void*)ERRSV, OutCopFILE(PL_curcop));
+                      SVfARG(ERRSV), OutCopFILE(PL_curcop));
        else
            Perl_croak(aTHX_ "%s has too many errors.\n",
             OutCopFILE(PL_curcop));