#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)
+
#ifdef PERL_MAD
# define PL_endwhite (PL_parser->endwhite)
/*
* Perl_lex_start
- * Initialize variables. Uses the Perl save_stack to save its state (for
- * recursive calls to the parser).
+ * Create a parser object and initialise its parser and lexer fields
*/
void
parser->yyerrstatus = 0;
parser->yychar = YYEMPTY; /* Cause a token to be read. */
+ /* on scope exit, free this parser and restore any outer one */
+ SAVEPARSER(parser);
+
/* initialise lexer state */
- SAVEI32(PL_lex_state);
+ SAVEI8(PL_lex_state);
#ifdef PERL_MAD
if (PL_lex_state == LEX_KNOWNEXT) {
I32 toke = parser->old_parser->lasttoke;
}
}
SAVEI32(PL_curforce);
+ PL_curforce = -1;
#else
if (PL_lex_state == LEX_KNOWNEXT) {
I32 toke = PL_nexttoke;
SAVEPPTR(PL_last_lop);
SAVEPPTR(PL_last_uni);
SAVEPPTR(PL_linestart);
- SAVESPTR(PL_linestr);
SAVEDESTRUCTOR_X(restore_rsfp, PL_rsfp);
- SAVEINT(PL_expect);
+ SAVEI8(PL_expect);
PL_copline = NOLINE;
PL_lex_state = LEX_NORMAL;
} 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;
+ parser->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_oldoldbufptr = PL_oldbufptr = PL_bufptr = PL_linestart = SvPVX(parser->linestr);
+ PL_bufend = PL_bufptr + SvCUR(parser->linestr);
PL_last_lop = PL_last_uni = NULL;
PL_rsfp = 0;
}
+
+/* delete a parser object */
+
+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_parser = parser->old_parser;
+ Safefree(parser);
+}
+
+
/*
* Perl_lex_end
* Finalizer for lexing operations. Must be called when the parser is
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);
*/
if (*start == '$') {
- if (gv || PL_last_lop_op == OP_PRINT || isUPPER(*PL_tokenbuf))
+ if (gv || PL_last_lop_op == OP_PRINT || PL_last_lop_op == OP_SAY ||
+ isUPPER(*PL_tokenbuf))
return 0;
#ifdef PERL_MAD
len = start - SvPVX(PL_linestr);
&& GvCVu(gv_readpipe) && GvIMPORTED_CV(gv_readpipe))
||
((gvp = (GV**)hv_fetchs(PL_globalstash, "readpipe", FALSE))
- && (gv_readpipe = *gvp) != (GV*)&PL_sv_undef
+ && (gv_readpipe = *gvp) && isGV_with_GP(gv_readpipe)
&& GvCVu(gv_readpipe) && GvIMPORTED_CV(gv_readpipe)))
{
PL_lex_op = (OP*)newUNOP(OP_ENTERSUB, OPf_STACKED,
#endif
#ifdef PERL_MAD
PL_realtokenstart = -1;
- s = SKIPSPACE0(s);
-#else
- s++;
+ if (!PL_thiswhite)
+ PL_thiswhite = newSVpvs("");
+ sv_catpvn(PL_thiswhite, s, 1);
#endif
+ s++;
goto retry;
case '#':
case '\n':
}
if (!ogv &&
(gvp = (GV**)hv_fetch(PL_globalstash,PL_tokenbuf,len,FALSE)) &&
- (gv = *gvp) != (GV*)&PL_sv_undef &&
+ (gv = *gvp) && isGV_with_GP(gv) &&
GvCVu(gv) && GvIMPORTED_CV(gv))
{
ogv = gv;
}
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 */
}
PL_nextwhite = 0;
}
}
+ else
#endif
- goto its_constant;
+ goto its_constant;
}
}
#ifdef PERL_MAD
"Ambiguous use of -%s resolved as -&%s()",
PL_tokenbuf, PL_tokenbuf);
/* Check for a constant sub */
- if ((sv = gv_const_sv(gv))) {
+ if ((sv = gv_const_sv(gv)) && !PL_madskills) {
its_constant:
SvREFCNT_dec(((SVOP*)yylval.opval)->op_sv);
((SVOP*)yylval.opval)->op_sv = SvREFCNT_inc_simple(sv);
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
case KEY_readpipe:
set_csh();
- UNI(OP_BACKTICK);
+ UNIDOR(OP_BACKTICK);
case KEY_rewinddir:
UNI(OP_REWINDDIR);
if (pit == '@' && PL_lex_state != LEX_NORMAL && !PL_lex_brackets) {
GV *gv = gv_fetchpv(PL_tokenbuf+1, 0, SVt_PVAV);
if ((!gv || ((PL_tokenbuf[0] == '@') ? !GvAV(gv) : !GvHV(gv)))
- && ckWARN(WARN_AMBIGUOUS))
+ && ckWARN(WARN_AMBIGUOUS)
+ /* DO NOT warn for @- and @+ */
+ && !( PL_tokenbuf[2] == '\0' &&
+ ( PL_tokenbuf[1] == '-' || PL_tokenbuf[1] == '+' ))
+ )
{
/* Downgraded from fatal to warning 20000522 mjd */
Perl_warner(aTHX_ packWARN(WARN_AMBIGUOUS),
}
while (isSPACE(*w))
++w;
- if (!*w || !strchr(";|})]oaiuw!=", *w)) /* an advisory hack only... */
+ /* the list of chars below is for end of statements or
+ * block / parens, boolean operators (&&, ||, //) and branch
+ * constructs (or, and, if, until, unless, while, err, for).
+ * Not a very solid hack... */
+ if (!*w || !strchr(";&/|})]oaiuwef!=", *w))
Perl_warner(aTHX_ packWARN(WARN_SYNTAX),
"%s (...) interpreted as function",name);
}
}
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;
&& GvCVu(gv_readline) && GvIMPORTED_CV(gv_readline))
||
((gvp = (GV**)hv_fetchs(PL_globalstash, "readline", FALSE))
- && (gv_readline = *gvp) != (GV*)&PL_sv_undef
+ && (gv_readline = *gvp) && isGV_with_GP(gv_readline)
&& GvCVu(gv_readline) && GvIMPORTED_CV(gv_readline)))
readline_overriden = TRUE;
case 'v':
vstring:
sv = newSV(5); /* preallocate storage space */
- s = scan_vstring(s,sv);
+ s = scan_vstring(s, PL_bufend, sv);
break;
}
Function must be called like
sv = newSV(5);
- s = scan_vstring(s,sv);
+ s = scan_vstring(s,e,sv);
+where s and e are the start and end of the string.
The sv should already be large enough to store the vstring
passed in, for performance reasons.
*/
char *
-Perl_scan_vstring(pTHX_ const char *s, SV *sv)
+Perl_scan_vstring(pTHX_ const char *s, const char *e, SV *sv)
{
dVAR;
const char *pos = s;
const char *start = s;
if (*pos == 'v') pos++; /* get past 'v' */
- while (pos < PL_bufend && (isDIGIT(*pos) || *pos == '_'))
+ while (pos < e && (isDIGIT(*pos) || *pos == '_'))
pos++;
if ( *pos != '.') {
/* this may not be a v-string if followed by => */
const char *next = pos;
- while (next < PL_bufend && isSPACE(*next))
+ while (next < e && isSPACE(*next))
++next;
- if ((PL_bufend - next) >= 2 && *next == '=' && next[1] == '>' ) {
+ if ((e - next) >= 2 && *next == '=' && next[1] == '>' ) {
/* return string not v-string */
sv_setpvn(sv,(char *)s,pos-s);
return (char *)pos;
sv_catpvn(sv, (const char*)tmpbuf, tmpend - tmpbuf);
if (!UNI_IS_INVARIANT(NATIVE_TO_UNI(rev)))
SvUTF8_on(sv);
- if (pos + 1 < PL_bufend && *pos == '.' && isDIGIT(pos[1]))
+ if (pos + 1 < e && *pos == '.' && isDIGIT(pos[1]))
s = ++pos;
else {
s = pos;
break;
}
- while (pos < PL_bufend && (isDIGIT(*pos) || *pos == '_'))
+ while (pos < e && (isDIGIT(*pos) || *pos == '_'))
pos++;
}
SvPOK_on(sv);