#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
/* 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;
}
void
Perl_parser_free(pTHX_ const yy_parser *parser)
{
+ SvREFCNT_dec(parser->linestr);
+
Safefree(parser->stack);
Safefree(parser->lex_brackstack);
Safefree(parser->lex_casestack);
PL_expect = XOPERATOR;
}
}
+ if (PL_madskills)
+ curmad('g', newSVpvs( "forced" ));
NEXTVAL_NEXTTOKE.opval
= (OP*)newSVOP(OP_CONST,0,
S_newSV_maybe_utf8(aTHX_ PL_tokenbuf, len));
}
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;
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);
}
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 */
}
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
}
pm = (PMOP*)newPMOP(type, 0);
- if (PL_multi_open == '?')
+ if (PL_multi_open == '?') {
+ /* This is the only point in the code that sets PMf_ONCE: */
pm->op_pmflags |= PMf_ONCE;
+
+ /* Hence it's safe to do this bit of PMOP book-keeping here, which
+ allows us to restrict the list needed by reset to just the ??
+ matches. */
+ assert(type != OP_TRANS);
+ if (PL_curstash) {
+ MAGIC *mg = mg_find((SV*)PL_curstash, PERL_MAGIC_symtab);
+ U32 elements;
+ if (!mg) {
+ mg = sv_magicext((SV*)PL_curstash, 0, PERL_MAGIC_symtab, 0, 0,
+ 0);
+ }
+ elements = mg->mg_len / sizeof(PMOP**);
+ Renewc(mg->mg_ptr, elements + 1, PMOP*, char);
+ ((PMOP**)mg->mg_ptr) [elements++] = pm;
+ mg->mg_len = elements * sizeof(PMOP**);
+ PmopSTASH_set(pm,PL_curstash);
+ }
+ }
#ifdef PERL_MAD
modstart = s;
#endif
"Use of /c modifier is meaningless without /g" );
}
- pm->op_pmpermflags = pm->op_pmflags;
-
PL_lex_op = (OP*)pm;
yylval.ival = OP_MATCH;
return s;
PL_lex_repl = repl;
}
- pm->op_pmpermflags = pm->op_pmflags;
PL_lex_op = (OP*)pm;
yylval.ival = OP_SUBST;
return s;