This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Added all traceable Unicode versions
[perl5.git] / toke.c
diff --git a/toke.c b/toke.c
index d5fbd0a..9726a31 100644 (file)
--- a/toke.c
+++ b/toke.c
 #define PL_pending_ident        (PL_parser->pending_ident)
 #define PL_preambled           (PL_parser->preambled)
 #define PL_sublex_info         (PL_parser->sublex_info)
+#define PL_linestr             (PL_parser->linestr)
+#define PL_expect              (PL_parser->expect)
+#define PL_copline             (PL_parser->copline)
+#define PL_bufptr              (PL_parser->bufptr)
+#define PL_oldbufptr           (PL_parser->oldbufptr)
+#define PL_oldoldbufptr                (PL_parser->oldoldbufptr)
+#define PL_linestart           (PL_parser->linestart)
+#define PL_bufend              (PL_parser->bufend)
+#define PL_last_uni            (PL_parser->last_uni)
+#define PL_last_lop            (PL_parser->last_lop)
+#define PL_last_lop_op         (PL_parser->last_lop_op)
+#define PL_lex_state           (PL_parser->lex_state)
 
 #ifdef PERL_MAD
 #  define PL_endwhite          (PL_parser->endwhite)
 #  define PL_thisstuff         (PL_parser->thisstuff)
 #  define PL_thistoken         (PL_parser->thistoken)
 #  define PL_thiswhite         (PL_parser->thiswhite)
+#  define PL_thiswhite         (PL_parser->thiswhite)
+#  define PL_nexttoke          (PL_parser->nexttoke)
+#  define PL_curforce          (PL_parser->curforce)
+#else
+#  define PL_nexttoke          (PL_parser->nexttoke)
+#  define PL_nexttype          (PL_parser->nexttype)
+#  define PL_nextval           (PL_parser->nextval)
 #endif
 
 static int
@@ -645,73 +664,44 @@ Perl_lex_start(pTHX_ SV *line)
 
     /* initialise lexer state */
 
-    SAVEI32(PL_lex_state);
-#ifdef PERL_MAD
-    if (PL_lex_state == LEX_KNOWNEXT) {
-       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_curforce);
-    PL_curforce = -1;
-#else
-    if (PL_lex_state == LEX_KNOWNEXT) {
-       I32 toke = PL_nexttoke;
-       while (--toke >= 0) {
-           SAVEI32(PL_nexttype[toke]);
-           SAVEVPTR(PL_nextval[toke]);
-       }
-       SAVEI32(PL_nexttoke);
-    }
-#endif
     SAVECOPLINE(PL_curcop);
-    SAVEPPTR(PL_bufptr);
-    SAVEPPTR(PL_bufend);
-    SAVEPPTR(PL_oldbufptr);
-    SAVEPPTR(PL_oldoldbufptr);
-    SAVEPPTR(PL_last_lop);
-    SAVEPPTR(PL_last_uni);
-    SAVEPPTR(PL_linestart);
-    SAVESPTR(PL_linestr);
     SAVEDESTRUCTOR_X(restore_rsfp, PL_rsfp);
-    SAVEINT(PL_expect);
 
-    PL_copline = NOLINE;
+#ifdef PERL_MAD
+    parser->curforce = -1;
+#else
+    parser->nexttoke = 0;
+#endif
+    parser->copline = NOLINE;
     PL_lex_state = LEX_NORMAL;
-    PL_expect = XSTATE;
+    parser->expect = XSTATE;
     Newx(parser->lex_brackstack, 120, char);
     Newx(parser->lex_casestack, 12, char);
     *parser->lex_casestack = '\0';
-#ifndef PERL_MAD
-    PL_nexttoke = 0;
-#endif
 
     if (line) {
        s = SvPV_const(line, len);
     } else {
        len = 0;
     }
+
     if (!len) {
-       PL_linestr = newSVpvs("\n;");
+       parser->linestr = newSVpvs("\n;");
     } else if (SvREADONLY(line) || s[len-1] != ';') {
-       PL_linestr = newSVsv(line);
+       parser->linestr = newSVsv(line);
        if (s[len-1] != ';')
-           sv_catpvs(PL_linestr, "\n;");
+           sv_catpvs(parser->linestr, "\n;");
     } else {
        SvTEMP_off(line);
        SvREFCNT_inc_simple_void_NN(line);
-       PL_linestr = line;
-    }
-    /* 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;
+       parser->linestr = line;
+    }
+    parser->oldoldbufptr =
+       parser->oldbufptr =
+       parser->bufptr =
+       parser->linestart = SvPVX(parser->linestr);
+    parser->bufend = parser->bufptr + SvCUR(parser->linestr);
+    parser->last_lop = parser->last_uni = NULL;
     PL_rsfp = 0;
 }
 
@@ -721,6 +711,8 @@ Perl_lex_start(pTHX_ SV *line)
 void
 Perl_parser_free(pTHX_  const yy_parser *parser)
 {
+    SvREFCNT_dec(parser->linestr);
+
     Safefree(parser->stack);
     Safefree(parser->lex_brackstack);
     Safefree(parser->lex_casestack);
@@ -1629,7 +1621,7 @@ S_sublex_start(pTHX)
     }
 
     PL_sublex_info.super_state = PL_lex_state;
-    PL_sublex_info.sub_inwhat = op_type;
+    PL_sublex_info.sub_inwhat = (U16)op_type;
     PL_sublex_info.sub_op = PL_lex_op;
     PL_lex_state = LEX_INTERPPUSH;
 
@@ -1658,13 +1650,13 @@ S_sublex_push(pTHX)
     ENTER;
 
     PL_lex_state = PL_sublex_info.super_state;
-    SAVEI32(PL_lex_dojoin);
+    SAVEBOOL(PL_lex_dojoin);
     SAVEI32(PL_lex_brackets);
     SAVEI32(PL_lex_casemods);
     SAVEI32(PL_lex_starts);
-    SAVEI32(PL_lex_state);
+    SAVEI8(PL_lex_state);
     SAVEVPTR(PL_lex_inpat);
-    SAVEI32(PL_lex_inwhat);
+    SAVEI16(PL_lex_inwhat);
     SAVECOPLINE(PL_curcop);
     SAVEPPTR(PL_bufptr);
     SAVEPPTR(PL_bufend);
@@ -5199,8 +5191,7 @@ Perl_yylex(pTHX)
            }
            else if (gv && !gvp
                     && -tmp==KEY_lock  /* XXX generalizable kludge */
-                    && GvCVu(gv)
-                    && !hv_fetchs(GvHVn(PL_incgv), "Thread.pm", FALSE))
+                    && GvCVu(gv))
            {
                tmp = 0;                /* any sub overrides "weak" keyword */
            }
@@ -6185,7 +6176,7 @@ Perl_yylex(pTHX)
        case KEY_our:
        case KEY_my:
        case KEY_state:
-           PL_in_my = tmp;
+           PL_in_my = (U16)tmp;
            s = SKIPSPACE1(s);
            if (isIDFIRST_lazy_if(s,UTF)) {
 #ifdef PERL_MAD