#define new_constant(a,b,c,d,e,f,g) \
S_new_constant(aTHX_ a,b,STR_WITH_LEN(c),d,e,f, g)
-#define yylval (PL_parser->yylval)
+#define pl_yylval (PL_parser->yylval)
/* YYINITDEPTH -- initial size of the parser's stacks. */
#define YYINITDEPTH 200
#define PRETERMBLOCK(retval) return (PL_expect = XTERMBLOCK,PL_bufptr = s, REPORT(retval))
#define PREREF(retval) return (PL_expect = XREF,PL_bufptr = s, REPORT(retval))
#define TERM(retval) return (CLINE, PL_expect = XOPERATOR, PL_bufptr = s, REPORT(retval))
-#define LOOPX(f) return (yylval.ival=f, PL_expect=XTERM, PL_bufptr=s, REPORT((int)LOOPEX))
-#define FTST(f) return (yylval.ival=f, PL_expect=XTERMORDORDOR, PL_bufptr=s, REPORT((int)UNIOP))
-#define FUN0(f) return (yylval.ival=f, PL_expect=XOPERATOR, PL_bufptr=s, REPORT((int)FUNC0))
-#define FUN1(f) return (yylval.ival=f, PL_expect=XOPERATOR, PL_bufptr=s, REPORT((int)FUNC1))
-#define BOop(f) return ao((yylval.ival=f, PL_expect=XTERM, PL_bufptr=s, REPORT((int)BITOROP)))
-#define BAop(f) return ao((yylval.ival=f, PL_expect=XTERM, PL_bufptr=s, REPORT((int)BITANDOP)))
-#define SHop(f) return ao((yylval.ival=f, PL_expect=XTERM, PL_bufptr=s, REPORT((int)SHIFTOP)))
-#define PWop(f) return ao((yylval.ival=f, PL_expect=XTERM, PL_bufptr=s, REPORT((int)POWOP)))
-#define PMop(f) return(yylval.ival=f, PL_expect=XTERM, PL_bufptr=s, REPORT((int)MATCHOP))
-#define Aop(f) return ao((yylval.ival=f, PL_expect=XTERM, PL_bufptr=s, REPORT((int)ADDOP)))
-#define Mop(f) return ao((yylval.ival=f, PL_expect=XTERM, PL_bufptr=s, REPORT((int)MULOP)))
-#define Eop(f) return (yylval.ival=f, PL_expect=XTERM, PL_bufptr=s, REPORT((int)EQOP))
-#define Rop(f) return (yylval.ival=f, PL_expect=XTERM, PL_bufptr=s, REPORT((int)RELOP))
+#define LOOPX(f) return (pl_yylval.ival=f, PL_expect=XTERM, PL_bufptr=s, REPORT((int)LOOPEX))
+#define FTST(f) return (pl_yylval.ival=f, PL_expect=XTERMORDORDOR, PL_bufptr=s, REPORT((int)UNIOP))
+#define FUN0(f) return (pl_yylval.ival=f, PL_expect=XOPERATOR, PL_bufptr=s, REPORT((int)FUNC0))
+#define FUN1(f) return (pl_yylval.ival=f, PL_expect=XOPERATOR, PL_bufptr=s, REPORT((int)FUNC1))
+#define BOop(f) return ao((pl_yylval.ival=f, PL_expect=XTERM, PL_bufptr=s, REPORT((int)BITOROP)))
+#define BAop(f) return ao((pl_yylval.ival=f, PL_expect=XTERM, PL_bufptr=s, REPORT((int)BITANDOP)))
+#define SHop(f) return ao((pl_yylval.ival=f, PL_expect=XTERM, PL_bufptr=s, REPORT((int)SHIFTOP)))
+#define PWop(f) return ao((pl_yylval.ival=f, PL_expect=XTERM, PL_bufptr=s, REPORT((int)POWOP)))
+#define PMop(f) return(pl_yylval.ival=f, PL_expect=XTERM, PL_bufptr=s, REPORT((int)MATCHOP))
+#define Aop(f) return ao((pl_yylval.ival=f, PL_expect=XTERM, PL_bufptr=s, REPORT((int)ADDOP)))
+#define Mop(f) return ao((pl_yylval.ival=f, PL_expect=XTERM, PL_bufptr=s, REPORT((int)MULOP)))
+#define Eop(f) return (pl_yylval.ival=f, PL_expect=XTERM, PL_bufptr=s, REPORT((int)EQOP))
+#define Rop(f) return (pl_yylval.ival=f, PL_expect=XTERM, PL_bufptr=s, REPORT((int)RELOP))
/* This bit of chicanery makes a unary function followed by
* a parenthesis into a function with one argument, highest precedence.
* operator (such as C<shift // 0>).
*/
#define UNI2(f,x) { \
- yylval.ival = f; \
+ pl_yylval.ival = f; \
PL_expect = x; \
PL_bufptr = s; \
PL_last_uni = PL_oldbufptr; \
#define UNIDOR(f) UNI2(f,XTERMORDORDOR)
#define UNIBRACK(f) { \
- yylval.ival = f; \
+ pl_yylval.ival = f; \
PL_bufptr = s; \
PL_last_uni = PL_oldbufptr; \
if (*s == '(') \
}
/* grandfather return to old style */
-#define OLDLOP(f) return(yylval.ival=f,PL_expect = XTERM,PL_bufptr = s,(int)LSTOP)
+#define OLDLOP(f) return(pl_yylval.ival=f,PL_expect = XTERM,PL_bufptr = s,(int)LSTOP)
#ifdef DEBUGGING
-/* how to interpret the yylval associated with the token */
+/* how to interpret the pl_yylval associated with the token */
enum token_type {
TOKENTYPE_NONE,
TOKENTYPE_IVAL,
- TOKENTYPE_OPNUM, /* yylval.ival contains an opcode number */
+ TOKENTYPE_OPNUM, /* pl_yylval.ival contains an opcode number */
TOKENTYPE_PVAL,
TOKENTYPE_OPVAL,
TOKENTYPE_GVVAL
{ 0, TOKENTYPE_NONE, NULL }
};
-/* dump the returned token in rv, plus any optional arg in yylval */
+/* dump the returned token in rv, plus any optional arg in pl_yylval */
STATIC int
S_tokereport(pTHX_ I32 rv)
case TOKENTYPE_GVVAL: /* doesn't appear to be used */
break;
case TOKENTYPE_IVAL:
- Perl_sv_catpvf(aTHX_ report, "(ival=%"IVdf")", (IV)yylval.ival);
+ Perl_sv_catpvf(aTHX_ report, "(ival=%"IVdf")", (IV)pl_yylval.ival);
break;
case TOKENTYPE_OPNUM:
Perl_sv_catpvf(aTHX_ report, "(ival=op_%s)",
- PL_op_name[yylval.ival]);
+ PL_op_name[pl_yylval.ival]);
break;
case TOKENTYPE_PVAL:
- Perl_sv_catpvf(aTHX_ report, "(pval=\"%s\")", yylval.pval);
+ Perl_sv_catpvf(aTHX_ report, "(pval=\"%s\")", pl_yylval.pval);
break;
case TOKENTYPE_OPVAL:
- if (yylval.opval) {
+ if (pl_yylval.opval) {
Perl_sv_catpvf(aTHX_ report, "(opval=op_%s)",
- PL_op_name[yylval.opval->op_type]);
- if (yylval.opval->op_type == OP_CONST) {
+ PL_op_name[pl_yylval.opval->op_type]);
+ if (pl_yylval.opval->op_type == OP_CONST) {
Perl_sv_catpvf(aTHX_ report, " %s",
- SvPEEK(cSVOPx_sv(yylval.opval)));
+ SvPEEK(cSVOPx_sv(pl_yylval.opval)));
}
}
if (*PL_bufptr == '=') {
PL_bufptr++;
if (toketype == ANDAND)
- yylval.ival = OP_ANDASSIGN;
+ pl_yylval.ival = OP_ANDASSIGN;
else if (toketype == OROR)
- yylval.ival = OP_ORASSIGN;
+ pl_yylval.ival = OP_ORASSIGN;
else if (toketype == DORDOR)
- yylval.ival = OP_DORASSIGN;
+ pl_yylval.ival = OP_DORASSIGN;
toketype = ASSIGNOP;
}
return toketype;
if (t - s > 0) {
const STRLEN len = t - s;
#ifndef USE_ITHREADS
- const char * const cf = CopFILE(PL_curcop);
- STRLEN tmplen = cf ? strlen(cf) : 0;
+ SV *const temp_sv = CopFILESV(PL_curcop);
+ const char *cf;
+ STRLEN tmplen;
+
+ if (temp_sv) {
+ cf = SvPVX(temp_sv);
+ tmplen = SvCUR(temp_sv);
+ } else {
+ cf = NULL;
+ tmplen = 0;
+ }
+
if (tmplen > 7 && strnEQ(cf, "(eval ", 6)) {
/* must copy *{"::_<(eval N)[oldfilename:L]"}
* to *{"::_<newfilename"} */
S_lop(pTHX_ I32 f, int x, char *s)
{
dVAR;
- yylval.ival = f;
+ pl_yylval.ival = f;
CLINE;
PL_expect = x;
PL_bufptr = s;
S_newSV_maybe_utf8(pTHX_ const char *start, STRLEN len)
{
dVAR;
- SV * const sv = newSVpvn(start,len);
- if (UTF && !IN_BYTES && is_utf8_string((const U8*)start, len))
- SvUTF8_on(sv);
+ SV * const sv = newSVpvn_utf8(start, len,
+ UTF && !IN_BYTES
+ && is_utf8_string((const U8*)start, len));
return sv;
}
#endif
if (*d == ';' || isSPACE(*d) || *d == '}' || !*d) {
SV *ver;
- s = scan_num(s, &yylval);
- version = yylval.opval;
+ s = scan_num(s, &pl_yylval);
+ version = pl_yylval.opval;
ver = cSVOPx(version)->op_sv;
if (SvPOK(ver) && !SvNIOK(ver)) {
SvUPGRADE(ver, SVt_PVNV);
goto finish;
d = s;
if ( PL_hints & HINT_NEW_STRING ) {
- pv = sv_2mortal(newSVpvn(SvPVX_const(pv), len));
- if (SvUTF8(sv))
- SvUTF8_on(pv);
+ pv = newSVpvn_flags(SvPVX_const(pv), len, SVs_TEMP | SvUTF8(sv));
}
while (s < send) {
if (*s == '\\') {
/*
* S_sublex_start
- * Assumes that yylval.ival is the op we're creating (e.g. OP_LCFIRST).
+ * Assumes that pl_yylval.ival is the op we're creating (e.g. OP_LCFIRST).
*
* Pattern matching will set PL_lex_op to the pattern-matching op to
- * make (we return THING if yylval.ival is OP_NULL, PMFUNC otherwise).
+ * make (we return THING if pl_yylval.ival is OP_NULL, PMFUNC otherwise).
*
* OP_CONST and OP_READLINE are easy--just make the new op and return.
*
S_sublex_start(pTHX)
{
dVAR;
- register const I32 op_type = yylval.ival;
+ register const I32 op_type = pl_yylval.ival;
if (op_type == OP_NULL) {
- yylval.opval = PL_lex_op;
+ pl_yylval.opval = PL_lex_op;
PL_lex_op = NULL;
return THING;
}
/* Overloaded constants, nothing fancy: Convert to SVt_PV: */
STRLEN len;
const char * const p = SvPV_const(sv, len);
- SV * const nsv = newSVpvn(p, len);
- if (SvUTF8(sv))
- SvUTF8_on(nsv);
+ SV * const nsv = newSVpvn_flags(p, len, SvUTF8(sv));
SvREFCNT_dec(sv);
sv = nsv;
}
- yylval.opval = (OP*)newSVOP(op_type, 0, sv);
+ pl_yylval.opval = (OP*)newSVOP(op_type, 0, sv);
PL_lex_stuff = NULL;
/* Allow <FH> // "foo" */
if (op_type == OP_READLINE)
else if (op_type == OP_BACKTICK && PL_lex_op) {
/* readpipe() vas overriden */
cSVOPx(cLISTOPx(cUNOPx(PL_lex_op)->op_first)->op_first->op_sibling)->op_sv = tokeq(PL_lex_stuff);
- yylval.opval = PL_lex_op;
+ pl_yylval.opval = PL_lex_op;
PL_lex_op = NULL;
PL_lex_stuff = NULL;
return THING;
PL_expect = XTERM;
if (PL_lex_op) {
- yylval.opval = PL_lex_op;
+ pl_yylval.opval = PL_lex_op;
PL_lex_op = NULL;
return PMFUNC;
}
if (SvUTF8(PL_linestr))
SvUTF8_on(sv);
PL_expect = XOPERATOR;
- yylval.opval = (OP*)newSVOP(OP_CONST, 0, sv);
+ pl_yylval.opval = (OP*)newSVOP(OP_CONST, 0, sv);
return THING;
}
Returns a pointer to the character scanned up to. If this is
advanced from the start pointer supplied (i.e. if anything was
successfully parsed), will leave an OP for the substring scanned
- in yylval. Caller must intuit reason for not parsing further
+ in pl_yylval. Caller must intuit reason for not parsing further
by looking at the next characters herself.
In patterns:
SvPV_shrink_to_cur(sv);
}
- /* return the substring (via yylval) only if we parsed anything */
+ /* return the substring (via pl_yylval) only if we parsed anything */
if (s > PL_bufptr) {
if ( PL_hints & ( PL_lex_inpat ? HINT_NEW_RE : HINT_NEW_STRING ) ) {
const char *const key = PL_lex_inpat ? "qr" : "q";
sv = S_new_constant(aTHX_ start, s - start, key, keylen, sv, NULL,
type, typelen);
}
- yylval.opval = (OP*)newSVOP(OP_CONST, 0, sv);
+ pl_yylval.opval = (OP*)newSVOP(OP_CONST, 0, sv);
} else
SvREFCNT_dec(sv);
return s;
return 0;
}
-/*
- * S_incl_perldb
- * Return a string of Perl code to load the debugger. If PERL5DB
- * is set, it will return the contents of that, otherwise a
- * compile-time require of perl5db.pl.
- */
-
-STATIC const char*
-S_incl_perldb(pTHX)
-{
- dVAR;
- if (PL_perldb) {
- const char * const pdb = PerlEnv_getenv("PERL5DB");
-
- if (pdb)
- return pdb;
- SETERRNO(0,SS_NORMAL);
- return "BEGIN { require 'perl5db.pl' }";
- }
- return "";
-}
-
-
/* Encoded script support. filter_add() effectively inserts a
* 'pre-processing' function into the current source input stream.
* Note that the filter function only applies to the current source file
{
GV **gvp;
GV *gv_readpipe = gv_fetchpvs("readpipe", GV_NOTQUAL, SVt_PVCV);
- yylval.ival = OP_BACKTICK;
+ pl_yylval.ival = OP_BACKTICK;
if ((gv_readpipe
&& GvCVu(gv_readpipe) && GvIMPORTED_CV(gv_readpipe))
||
case FUNC0SUB:
case UNIOPSUB:
case LSTOPSUB:
- if (yylval.opval)
- append_madprops(PL_thismad, yylval.opval, 0);
+ if (pl_yylval.opval)
+ append_madprops(PL_thismad, pl_yylval.opval, 0);
PL_thismad = 0;
return optype;
}
/* Create new token struct. Note: opvals return early above. */
- yylval.tkval = newTOKEN(optype, yylval, PL_thismad);
+ pl_yylval.tkval = newTOKEN(optype, pl_yylval, PL_thismad);
PL_thismad = 0;
return optype;
}
s = force_word(s,WORD,FALSE,TRUE,FALSE);
s = force_version(s, FALSE);
}
- yylval.ival = is_use;
+ pl_yylval.ival = is_use;
return s;
}
#ifdef DEBUGGING
case LEX_KNOWNEXT:
#ifdef PERL_MAD
PL_lasttoke--;
- yylval = PL_nexttoke[PL_lasttoke].next_val;
+ pl_yylval = PL_nexttoke[PL_lasttoke].next_val;
if (PL_madskills) {
PL_thismad = PL_nexttoke[PL_lasttoke].next_mad;
PL_nexttoke[PL_lasttoke].next_mad = 0;
}
#else
PL_nexttoke--;
- yylval = PL_nextval[PL_nexttoke];
+ pl_yylval = PL_nextval[PL_nexttoke];
if (!PL_nexttoke) {
PL_lex_state = PL_lex_defer;
PL_expect = PL_lex_expect;
sv = tokeq(sv);
else if ( PL_hints & HINT_NEW_RE )
sv = new_constant(NULL, 0, "qr", sv, sv, "q", 1);
- yylval.opval = (OP*)newSVOP(OP_CONST, 0, sv);
+ pl_yylval.opval = (OP*)newSVOP(OP_CONST, 0, sv);
s = PL_bufend;
}
else {
if (PL_madskills) {
curmad('X', newSVpvn(PL_bufptr,s-PL_bufptr));
}
- NEXTVAL_NEXTTOKE = yylval;
+ NEXTVAL_NEXTTOKE = pl_yylval;
PL_expect = XTERM;
force_next(THING);
if (PL_lex_starts++) {
if (PL_madskills)
PL_faketokens = 1;
#endif
- sv_setpv(PL_linestr,incl_perldb());
- if (SvCUR(PL_linestr))
- sv_catpvs(PL_linestr,";");
- if (PL_preambleav){
- while(AvFILLp(PL_preambleav) >= 0) {
- SV *tmpsv = av_shift(PL_preambleav);
- sv_catsv(PL_linestr, tmpsv);
+ if (PL_perldb) {
+ /* Generate a string of Perl code to load the debugger.
+ * If PERL5DB is set, it will return the contents of that,
+ * otherwise a compile-time require of perl5db.pl. */
+
+ const char * const pdb = PerlEnv_getenv("PERL5DB");
+
+ if (pdb) {
+ sv_setpv(PL_linestr, pdb);
+ sv_catpvs(PL_linestr,";");
+ } else {
+ SETERRNO(0,SS_NORMAL);
+ sv_setpvs(PL_linestr, "BEGIN { require 'perl5db.pl' };");
+ }
+ } else
+ sv_setpvs(PL_linestr,"");
+ if (PL_preambleav) {
+ SV **svp = AvARRAY(PL_preambleav);
+ SV **const end = svp + AvFILLp(PL_preambleav);
+ while(svp <= end) {
+ sv_catsv(PL_linestr, *svp);
+ ++svp;
sv_catpvs(PL_linestr, ";");
- sv_free(tmpsv);
}
sv_free((SV*)PL_preambleav);
PL_preambleav = NULL;
}
}
if (PL_minus_E)
- sv_catpvs(PL_linestr,"use feature ':5.10';");
+ sv_catpvs(PL_linestr,
+ "use feature ':5." STRINGIFY(PERL_VERSION) "';");
sv_catpvs(PL_linestr, "\n");
PL_oldoldbufptr = PL_oldbufptr = s = PL_linestart = SvPVX(PL_linestr);
PL_bufend = SvPVX(PL_linestr) + SvCUR(PL_linestr);
if (PL_madskills)
PL_faketokens = 1;
#endif
- sv_setpv(PL_linestr,
- (const char *)
- (PL_minus_p
- ? ";}continue{print;}" : ";}"));
+ if (PL_minus_p)
+ sv_setpvs(PL_linestr, ";}continue{print;}");
+ else
+ sv_setpvs(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 = NULL;
sv_free(sv);
if (PL_in_my == KEY_our) {
#ifdef USE_ITHREADS
- GvUNIQUE_on(cGVOPx_gv(yylval.opval));
+ GvUNIQUE_on(cGVOPx_gv(pl_yylval.opval));
#else
/* skip to avoid loading attributes.pm */
#endif
}
break;
}
- yylval.ival = CopLINE(PL_curcop);
+ pl_yylval.ival = CopLINE(PL_curcop);
if (isSPACE(*s) || *s == '#')
PL_copline = NOLINE; /* invalidate current command line number */
TOKEN('{');
}
else
PREREF('&');
- yylval.ival = (OPpENTERSUB_AMPER<<8);
+ pl_yylval.ival = (OPpENTERSUB_AMPER<<8);
TERM('&');
case '|':
goto leftbracket;
}
}
- yylval.ival = 0;
+ pl_yylval.ival = 0;
OPERATOR(ASSIGNOP);
case '!':
s++;
/* This kludge not intended to be bulletproof. */
if (PL_tokenbuf[1] == '[' && !PL_tokenbuf[2]) {
- yylval.opval = newSVOP(OP_CONST, 0,
+ pl_yylval.opval = newSVOP(OP_CONST, 0,
newSViv(CopARYBASE_get(&PL_compiling)));
- yylval.opval->op_private = OPpCONST_ARYBASE;
+ pl_yylval.opval->op_private = OPpCONST_ARYBASE;
TERM(THING);
}
s++;
if (*s == tmp) {
s++;
- yylval.ival = OPf_SPECIAL;
+ pl_yylval.ival = OPf_SPECIAL;
}
else
- yylval.ival = 0;
+ pl_yylval.ival = 0;
OPERATOR(DOTDOT);
}
if (PL_expect != XOPERATOR)
/* FALL THROUGH */
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);
+ s = scan_num(s, &pl_yylval);
DEBUG_T( { printbuf("### Saw number in %s\n", s); } );
if (PL_expect == XOPERATOR)
no_op("Number",s);
}
if (!s)
missingterm(NULL);
- yylval.ival = OP_CONST;
+ pl_yylval.ival = OP_CONST;
TERM(sublex_start());
case '"':
}
if (!s)
missingterm(NULL);
- yylval.ival = OP_CONST;
+ pl_yylval.ival = OP_CONST;
/* FIXME. I think that this can be const if char *d is replaced by
more localised variables. */
for (d = SvPV(PL_lex_stuff, len); len; len--, d++) {
if (*d == '$' || *d == '@' || *d == '\\' || !UTF8_IS_INVARIANT((U8)*d)) {
- yylval.ival = OP_STRINGIFY;
+ pl_yylval.ival = OP_STRINGIFY;
break;
}
}
while (isDIGIT(*start) || *start == '_')
start++;
if (*start == '.' && isDIGIT(start[1])) {
- s = scan_num(s, &yylval);
+ s = scan_num(s, &pl_yylval);
TERM(THING);
}
/* avoid v123abc() or $h{v1}, allow C<print v10;> */
|| PL_expect == XTERMORDORDOR)) {
GV *const gv = gv_fetchpvn_flags(s, start - s, 0, SVt_PVCV);
if (!gv) {
- s = scan_num(s, &yylval);
+ s = scan_num(s, &pl_yylval);
TERM(THING);
}
}
if (!tmp && PL_expect == XSTATE
&& d < PL_bufend && *d == ':' && *(d + 1) != ':') {
s = d + 1;
- yylval.pval = CopLABEL_alloc(PL_tokenbuf);
+ pl_yylval.pval = CopLABEL_alloc(PL_tokenbuf);
CLINE;
TOKEN(LABEL);
}
/* Is this a word before a => operator? */
if (*d == '=' && d[1] == '>') {
CLINE;
- yylval.opval
+ pl_yylval.opval
= (OP*)newSVOP(OP_CONST, 0,
S_newSV_maybe_utf8(aTHX_ PL_tokenbuf, len));
- yylval.opval->op_private = OPpCONST_BARE;
+ pl_yylval.opval->op_private = OPpCONST_BARE;
TERM(WORD);
}
#ifdef PERL_MAD
if (PL_madskills && !PL_thistoken) {
char *start = SvPVX(PL_linestr) + PL_realtokenstart;
- PL_thistoken = newSVpv(start,s - start);
+ PL_thistoken = newSVpvn(start,s - start);
PL_realtokenstart = s - SvPVX(PL_linestr);
}
#endif
/* Presume this is going to be a bareword of some sort. */
CLINE;
- yylval.opval = (OP*)newSVOP(OP_CONST, 0, sv);
- yylval.opval->op_private = OPpCONST_BARE;
+ pl_yylval.opval = (OP*)newSVOP(OP_CONST, 0, sv);
+ pl_yylval.opval->op_private = OPpCONST_BARE;
/* UTF-8 package name? */
if (UTF && !IN_BYTES &&
is_utf8_string((U8*)SvPVX_const(sv), SvCUR(sv)))
/* Is this a word before a => operator? */
if (*s == '=' && s[1] == '>' && !pkgname) {
CLINE;
- sv_setpv(((SVOP*)yylval.opval)->op_sv, PL_tokenbuf);
+ sv_setpv(((SVOP*)pl_yylval.opval)->op_sv, PL_tokenbuf);
if (UTF && !IN_BYTES && is_utf8_string((U8*)PL_tokenbuf, len))
- SvUTF8_on(((SVOP*)yylval.opval)->op_sv);
+ SvUTF8_on(((SVOP*)pl_yylval.opval)->op_sv);
TERM(WORD);
}
}
start_force(PL_curforce);
#endif
- NEXTVAL_NEXTTOKE.opval = yylval.opval;
+ NEXTVAL_NEXTTOKE.opval = pl_yylval.opval;
PL_expect = XOPERATOR;
#ifdef PERL_MAD
if (PL_madskills) {
}
#endif
force_next(WORD);
- yylval.ival = 0;
+ pl_yylval.ival = 0;
TOKEN('&');
}
/* Check for a constant sub */
if ((sv = gv_const_sv(gv))) {
its_constant:
- SvREFCNT_dec(((SVOP*)yylval.opval)->op_sv);
- ((SVOP*)yylval.opval)->op_sv = SvREFCNT_inc_simple(sv);
- yylval.opval->op_private = 0;
+ SvREFCNT_dec(((SVOP*)pl_yylval.opval)->op_sv);
+ ((SVOP*)pl_yylval.opval)->op_sv = SvREFCNT_inc_simple(sv);
+ pl_yylval.opval->op_private = 0;
TOKEN(WORD);
}
cv = GvCV(gv);
}
- op_free(yylval.opval);
- yylval.opval = newCVREF(0, newGVOP(OP_GV, 0, gv));
- yylval.opval->op_private |= OPpENTERSUB_NOPAREN;
+ op_free(pl_yylval.opval);
+ pl_yylval.opval = newCVREF(0, newGVOP(OP_GV, 0, gv));
+ pl_yylval.opval->op_private |= OPpENTERSUB_NOPAREN;
PL_last_lop = PL_oldbufptr;
PL_last_lop_op = OP_ENTERSUB;
/* Is there a prototype? */
while (*proto == ';')
proto++;
if (*proto == '&' && *s == '{') {
- sv_setpv(PL_subname,
- (const char *)
- (PL_curstash ?
- "__ANON__" : "__ANON__::__ANON__"));
+ if (PL_curstash)
+ sv_setpvs(PL_subname, "__ANON__");
+ else
+ sv_setpvs(PL_subname, "__ANON__::__ANON__");
PREBLOCK(LSTOPSUB);
}
}
PL_thiswhite = 0;
}
start_force(PL_curforce);
- NEXTVAL_NEXTTOKE.opval = yylval.opval;
+ NEXTVAL_NEXTTOKE.opval = pl_yylval.opval;
PL_expect = XTERM;
if (PL_madskills) {
PL_nextwhite = nextPL_nextwhite;
}
if (probable_sub) {
gv = gv_fetchpv(PL_tokenbuf, GV_ADD, SVt_PVCV);
- op_free(yylval.opval);
- yylval.opval = newCVREF(0, newGVOP(OP_GV, 0, gv));
- yylval.opval->op_private |= OPpENTERSUB_NOPAREN;
+ op_free(pl_yylval.opval);
+ pl_yylval.opval = newCVREF(0, newGVOP(OP_GV, 0, gv));
+ pl_yylval.opval->op_private |= OPpENTERSUB_NOPAREN;
PL_last_lop = PL_oldbufptr;
PL_last_lop_op = OP_ENTERSUB;
PL_nextwhite = PL_thiswhite;
PL_thiswhite = 0;
start_force(PL_curforce);
- NEXTVAL_NEXTTOKE.opval = yylval.opval;
+ NEXTVAL_NEXTTOKE.opval = pl_yylval.opval;
PL_expect = XTERM;
PL_nextwhite = nextPL_nextwhite;
curmad('X', PL_thistoken);
TOKEN(NOAMP);
}
#else
- NEXTVAL_NEXTTOKE.opval = yylval.opval;
+ NEXTVAL_NEXTTOKE.opval = pl_yylval.opval;
PL_expect = XTERM;
force_next(WORD);
TOKEN(NOAMP);
/* Call it a bare word */
if (PL_hints & HINT_STRICT_SUBS)
- yylval.opval->op_private |= OPpCONST_STRICT;
+ pl_yylval.opval->op_private |= OPpCONST_STRICT;
else {
bareword:
if (lastchar != '-') {
}
case KEY___FILE__:
- yylval.opval = (OP*)newSVOP(OP_CONST, 0,
+ pl_yylval.opval = (OP*)newSVOP(OP_CONST, 0,
newSVpv(CopFILE(PL_curcop),0));
TERM(THING);
case KEY___LINE__:
- yylval.opval = (OP*)newSVOP(OP_CONST, 0,
+ pl_yylval.opval = (OP*)newSVOP(OP_CONST, 0,
Perl_newSVpvf(aTHX_ "%"IVdf, (IV)CopLINE(PL_curcop)));
TERM(THING);
case KEY___PACKAGE__:
- yylval.opval = (OP*)newSVOP(OP_CONST, 0,
+ pl_yylval.opval = (OP*)newSVOP(OP_CONST, 0,
(PL_curstash
? newSVhek(HvNAME_HEK(PL_curstash))
: &PL_sv_undef));
s = force_word(s,WORD,TRUE,TRUE,FALSE);
if (orig_keyword == KEY_do) {
orig_keyword = 0;
- yylval.ival = 1;
+ pl_yylval.ival = 1;
}
else
- yylval.ival = 0;
+ pl_yylval.ival = 0;
OPERATOR(DO);
case KEY_die:
PREBLOCK(ELSE);
case KEY_elsif:
- yylval.ival = CopLINE(PL_curcop);
+ pl_yylval.ival = CopLINE(PL_curcop);
OPERATOR(ELSIF);
case KEY_eq:
case KEY_for:
case KEY_foreach:
- yylval.ival = CopLINE(PL_curcop);
+ pl_yylval.ival = CopLINE(PL_curcop);
s = SKIPSPACE1(s);
if (PL_expect == XSTATE && isIDFIRST_lazy_if(s,UTF)) {
char *p = s;
FUN0(OP_GETLOGIN);
case KEY_given:
- yylval.ival = CopLINE(PL_curcop);
+ pl_yylval.ival = CopLINE(PL_curcop);
OPERATOR(GIVEN);
case KEY_glob:
UNI(OP_HEX);
case KEY_if:
- yylval.ival = CopLINE(PL_curcop);
+ pl_yylval.ival = CopLINE(PL_curcop);
OPERATOR(IF);
case KEY_index:
UNI(OP_LCFIRST);
case KEY_local:
- yylval.ival = 0;
+ pl_yylval.ival = 0;
OPERATOR(LOCAL);
case KEY_length:
}
#endif
}
- yylval.ival = 1;
+ pl_yylval.ival = 1;
OPERATOR(MY);
case KEY_next:
LOP(OP_OPEN,XTERM);
case KEY_or:
- yylval.ival = OP_OR;
+ pl_yylval.ival = OP_OR;
OPERATOR(OROP);
case KEY_ord:
s = scan_str(s,!!PL_madskills,FALSE);
if (!s)
missingterm(NULL);
- yylval.ival = OP_CONST;
+ pl_yylval.ival = OP_CONST;
TERM(sublex_start());
case KEY_quotemeta:
for (; !isSPACE(*d) && len; --len, ++d)
/**/;
}
- sv = newSVpvn(b, d-b);
- if (DO_UTF8(PL_lex_stuff))
- SvUTF8_on(sv);
+ sv = newSVpvn_utf8(b, d-b, DO_UTF8(PL_lex_stuff));
words = append_elem(OP_LIST, words,
newSVOP(OP_CONST, 0, tokeq(sv)));
}
s = scan_str(s,!!PL_madskills,FALSE);
if (!s)
missingterm(NULL);
- yylval.ival = OP_STRINGIFY;
+ pl_yylval.ival = OP_STRINGIFY;
if (SvIVX(PL_lex_stuff) == '\'')
SvIV_set(PL_lex_stuff, 0); /* qq'$foo' should intepolate */
TERM(sublex_start());
}
if (orig_keyword == KEY_require) {
orig_keyword = 0;
- yylval.ival = 1;
+ pl_yylval.ival = 1;
}
else
- yylval.ival = 0;
+ pl_yylval.ival = 0;
PL_expect = XTERM;
PL_bufptr = s;
PL_last_uni = PL_oldbufptr;
case KEY_s:
s = scan_subst(s);
- if (yylval.opval)
+ if (pl_yylval.opval)
TERM(sublex_start());
else
TOKEN(1); /* force error */
}
#endif
if (!have_name) {
- sv_setpv(PL_subname,
- (const char *)
- (PL_curstash ? "__ANON__" : "__ANON__::__ANON__"));
+ if (PL_curstash)
+ sv_setpvs(PL_subname, "__ANON__");
+ else
+ sv_setpvs(PL_subname, "__ANON__::__ANON__");
TOKEN(ANONSUB);
}
#ifndef PERL_MAD
UNI(OP_UNTIE);
case KEY_until:
- yylval.ival = CopLINE(PL_curcop);
+ pl_yylval.ival = CopLINE(PL_curcop);
OPERATOR(UNTIL);
case KEY_unless:
- yylval.ival = CopLINE(PL_curcop);
+ pl_yylval.ival = CopLINE(PL_curcop);
OPERATOR(UNLESS);
case KEY_unlink:
LOP(OP_VEC,XTERM);
case KEY_when:
- yylval.ival = CopLINE(PL_curcop);
+ pl_yylval.ival = CopLINE(PL_curcop);
OPERATOR(WHEN);
case KEY_while:
- yylval.ival = CopLINE(PL_curcop);
+ pl_yylval.ival = CopLINE(PL_curcop);
OPERATOR(WHILE);
case KEY_warn:
goto just_a_word;
case KEY_xor:
- yylval.ival = OP_XOR;
+ pl_yylval.ival = OP_XOR;
OPERATOR(OROP);
case KEY_y:
yyerror(Perl_form(aTHX_ PL_no_myglob,
PL_in_my == KEY_my ? "my" : "state", PL_tokenbuf));
- yylval.opval = newOP(OP_PADANY, 0);
- yylval.opval->op_targ = allocmy(PL_tokenbuf);
+ pl_yylval.opval = newOP(OP_PADANY, 0);
+ pl_yylval.opval->op_targ = allocmy(PL_tokenbuf);
return PRIVATEREF;
}
}
SV * const sym = newSVhek(stashname);
sv_catpvs(sym, "::");
sv_catpvn(sym, PL_tokenbuf+1, tokenbuf_len - 1);
- yylval.opval = (OP*)newSVOP(OP_CONST, 0, sym);
- yylval.opval->op_private = OPpCONST_ENTERED;
+ pl_yylval.opval = (OP*)newSVOP(OP_CONST, 0, sym);
+ pl_yylval.opval->op_private = OPpCONST_ENTERED;
gv_fetchsv(sym,
(PL_in_eval
? (GV_ADDMULTI | GV_ADDINEVAL)
}
}
- yylval.opval = newOP(OP_PADANY, 0);
- yylval.opval->op_targ = tmp;
+ pl_yylval.opval = newOP(OP_PADANY, 0);
+ pl_yylval.opval->op_targ = tmp;
return PRIVATEREF;
}
}
}
/* build ops for a bareword */
- yylval.opval = (OP*)newSVOP(OP_CONST, 0, newSVpvn(PL_tokenbuf + 1,
+ pl_yylval.opval = (OP*)newSVOP(OP_CONST, 0, newSVpvn(PL_tokenbuf + 1,
tokenbuf_len - 1));
- yylval.opval->op_private = OPpCONST_ENTERED;
+ pl_yylval.opval->op_private = OPpCONST_ENTERED;
gv_fetchpvn_flags(
PL_tokenbuf + 1, tokenbuf_len - 1,
/* If the identifier refers to a stash, don't autovivify it.
sv_2mortal(sv); /* Parent created it permanently */
cv = *cvp;
if (!pv && s)
- pv = sv_2mortal(newSVpvn(s, len));
+ pv = newSVpvn_flags(s, len, SVs_TEMP);
if (type && pv)
- typesv = sv_2mortal(newSVpvn(type, typelen));
+ typesv = newSVpvn_flags(type, typelen, SVs_TEMP);
else
typesv = &PL_sv_undef;
}
PL_lex_op = (OP*)pm;
- yylval.ival = OP_MATCH;
+ pl_yylval.ival = OP_MATCH;
return s;
}
char *modstart;
#endif
- yylval.ival = OP_NULL;
+ pl_yylval.ival = OP_NULL;
s = scan_str(start,!!PL_madskills,FALSE);
}
PL_lex_op = (OP*)pm;
- yylval.ival = OP_SUBST;
+ pl_yylval.ival = OP_SUBST;
return s;
}
char *modstart;
#endif
- yylval.ival = OP_NULL;
+ pl_yylval.ival = OP_NULL;
s = scan_str(start,!!PL_madskills,FALSE);
if (!s)
(DO_UTF8(PL_lex_repl) ? OPpTRANS_TO_UTF : 0);
PL_lex_op = o;
- yylval.ival = OP_TRANS;
+ pl_yylval.ival = OP_TRANS;
#ifdef PERL_MAD
if (PL_madskills) {
sv_recode_to_utf8(tmpstr, PL_encoding);
}
PL_lex_stuff = tmpstr;
- yylval.ival = op_type;
+ pl_yylval.ival = op_type;
return s;
}
/* scan_inputsymbol
takes: current position in input buffer
returns: new position in input buffer
- side-effects: yylval and lex_op are set.
+ side-effects: pl_yylval and lex_op are set.
This code handles:
*/
if (d - PL_tokenbuf != len) {
- yylval.ival = OP_GLOB;
+ pl_yylval.ival = OP_GLOB;
s = scan_str(start,!!PL_madskills,FALSE);
if (!s)
Perl_croak(aTHX_ "Glob not terminated");
}
if (!readline_overriden)
PL_lex_op->op_flags |= OPf_SPECIAL;
- /* we created the ops in PL_lex_op, so make yylval.ival a null op */
- yylval.ival = OP_NULL;
+ /* we created the ops in PL_lex_op, so make pl_yylval.ival a null op */
+ pl_yylval.ival = OP_NULL;
}
/* If it's none of the above, it must be a literal filehandle
newGVOP(OP_GV, 0, gv),
newCVREF(0, newGVOP(OP_GV, 0, gv_readline))))
: (OP*)newUNOP(OP_READLINE, 0, newGVOP(OP_GV, 0, gv));
- yylval.ival = OP_NULL;
+ pl_yylval.ival = OP_NULL;
}
}
scan_num
takes: pointer to position in buffer
returns: pointer to new position in buffer
- side-effects: builds ops for the constant in yylval.op
+ side-effects: builds ops for the constant in pl_yylval.op
Read a number in any of the formats that Perl accepts:
where = "within string";
}
else {
- SV * const where_sv = sv_2mortal(newSVpvs("next char "));
+ SV * const where_sv = newSVpvs_flags("next char ", SVs_TEMP);
if (yychar < 32)
Perl_sv_catpvf(aTHX_ where_sv, "^%c", toCTRL(yychar));
else if (isPRINT_LC(yychar)) {
https://perl5.git.perl.org / perl5.git / blobdiff