* Also see LOP and lop() below.
*/
+/* Note that REPORT() and REPORT2() will be expressions that supply
+ * their own trailing comma, not suitable for statements as such. */
#ifdef DEBUGGING /* Serve -DT. */
-# define REPORT(x,retval) tokereport(x,s,(int)retval)
-# define REPORT2(x,retval) tokereport(x,s, yylval.ival)
+# define REPORT(x,retval) tokereport(x,s,(int)retval),
+# define REPORT2(x,retval) tokereport(x,s, yylval.ival),
#else
-# define REPORT(x,retval) 1
-# define REPORT2(x,retval) 1
+# define REPORT(x,retval)
+# define REPORT2(x,retval)
#endif
-#define TOKEN(retval) return (REPORT2("token",retval), PL_bufptr = s,(int)retval)
-#define OPERATOR(retval) return (REPORT2("operator",retval), PL_expect = XTERM, PL_bufptr = s,(int)retval)
-#define AOPERATOR(retval) return ao((REPORT2("aop",retval), PL_expect = XTERM, PL_bufptr = s,(int)retval))
-#define PREBLOCK(retval) return (REPORT2("preblock",retval), PL_expect = XBLOCK,PL_bufptr = s,(int)retval)
-#define PRETERMBLOCK(retval) return (REPORT2("pretermblock",retval), PL_expect = XTERMBLOCK,PL_bufptr = s,(int)retval)
-#define PREREF(retval) return (REPORT2("preref",retval), PL_expect = XREF,PL_bufptr = s,(int)retval)
-#define TERM(retval) return (CLINE, REPORT2("term",retval), PL_expect = XOPERATOR, PL_bufptr = s,(int)retval)
-#define LOOPX(f) return(yylval.ival=f, REPORT("loopx",f), PL_expect = XTERM,PL_bufptr = s,(int)LOOPEX)
-#define FTST(f) return(yylval.ival=f, REPORT("ftst",f), PL_expect = XTERM,PL_bufptr = s,(int)UNIOP)
-#define FUN0(f) return(yylval.ival = f, REPORT("fun0",f), PL_expect = XOPERATOR,PL_bufptr = s,(int)FUNC0)
-#define FUN1(f) return(yylval.ival = f, REPORT("fun1",f), PL_expect = XOPERATOR,PL_bufptr = s,(int)FUNC1)
-#define BOop(f) return ao((yylval.ival=f, REPORT("bitorop",f), PL_expect = XTERM,PL_bufptr = s,(int)BITOROP))
-#define BAop(f) return ao((yylval.ival=f, REPORT("bitandop",f), PL_expect = XTERM,PL_bufptr = s,(int)BITANDOP))
-#define SHop(f) return ao((yylval.ival=f, REPORT("shiftop",f), PL_expect = XTERM,PL_bufptr = s,(int)SHIFTOP))
-#define PWop(f) return ao((yylval.ival=f, REPORT("powop",f), PL_expect = XTERM,PL_bufptr = s,(int)POWOP))
-#define PMop(f) return(yylval.ival=f, REPORT("matchop",f), PL_expect = XTERM,PL_bufptr = s,(int)MATCHOP)
-#define Aop(f) return ao((yylval.ival=f, REPORT("add",f), PL_expect = XTERM,PL_bufptr = s,(int)ADDOP))
-#define Mop(f) return ao((yylval.ival=f, REPORT("mul",f), PL_expect = XTERM,PL_bufptr = s,(int)MULOP))
-#define Eop(f) return(yylval.ival=f, REPORT("eq",f), PL_expect = XTERM,PL_bufptr = s,(int)EQOP)
-#define Rop(f) return(yylval.ival=f, REPORT("rel",f), PL_expect = XTERM,PL_bufptr = s,(int)RELOP)
+#define TOKEN(retval) return (REPORT2("token",retval) PL_bufptr = s,(int)retval)
+#define OPERATOR(retval) return (REPORT2("operator",retval) PL_expect = XTERM, PL_bufptr = s,(int)retval)
+#define AOPERATOR(retval) return ao((REPORT2("aop",retval) PL_expect = XTERM, PL_bufptr = s,(int)retval))
+#define PREBLOCK(retval) return (REPORT2("preblock",retval) PL_expect = XBLOCK,PL_bufptr = s,(int)retval)
+#define PRETERMBLOCK(retval) return (REPORT2("pretermblock",retval) PL_expect = XTERMBLOCK,PL_bufptr = s,(int)retval)
+#define PREREF(retval) return (REPORT2("preref",retval) PL_expect = XREF,PL_bufptr = s,(int)retval)
+#define TERM(retval) return (CLINE, REPORT2("term",retval) PL_expect = XOPERATOR, PL_bufptr = s,(int)retval)
+#define LOOPX(f) return(yylval.ival=f, REPORT("loopx",f) PL_expect = XTERM,PL_bufptr = s,(int)LOOPEX)
+#define FTST(f) return(yylval.ival=f, REPORT("ftst",f) PL_expect = XTERM,PL_bufptr = s,(int)UNIOP)
+#define FUN0(f) return(yylval.ival = f, REPORT("fun0",f) PL_expect = XOPERATOR,PL_bufptr = s,(int)FUNC0)
+#define FUN1(f) return(yylval.ival = f, REPORT("fun1",f) PL_expect = XOPERATOR,PL_bufptr = s,(int)FUNC1)
+#define BOop(f) return ao((yylval.ival=f, REPORT("bitorop",f) PL_expect = XTERM,PL_bufptr = s,(int)BITOROP))
+#define BAop(f) return ao((yylval.ival=f, REPORT("bitandop",f) PL_expect = XTERM,PL_bufptr = s,(int)BITANDOP))
+#define SHop(f) return ao((yylval.ival=f, REPORT("shiftop",f) PL_expect = XTERM,PL_bufptr = s,(int)SHIFTOP))
+#define PWop(f) return ao((yylval.ival=f, REPORT("powop",f) PL_expect = XTERM,PL_bufptr = s,(int)POWOP))
+#define PMop(f) return(yylval.ival=f, REPORT("matchop",f) PL_expect = XTERM,PL_bufptr = s,(int)MATCHOP)
+#define Aop(f) return ao((yylval.ival=f, REPORT("add",f) PL_expect = XTERM,PL_bufptr = s,(int)ADDOP))
+#define Mop(f) return ao((yylval.ival=f, REPORT("mul",f) PL_expect = XTERM,PL_bufptr = s,(int)MULOP))
+#define Eop(f) return(yylval.ival=f, REPORT("eq",f) PL_expect = XTERM,PL_bufptr = s,(int)EQOP)
+#define Rop(f) return(yylval.ival=f, REPORT("rel",f) PL_expect = XTERM,PL_bufptr = s,(int)RELOP)
/* This bit of chicanery makes a unary function followed by
* a parenthesis into a function with one argument, highest precedence.
*/
#define UNI(f) return(yylval.ival = f, \
- REPORT("uni",f), \
+ REPORT("uni",f) \
PL_expect = XTERM, \
PL_bufptr = s, \
PL_last_uni = PL_oldbufptr, \
(*s == '(' || (s = skipspace(s), *s == '(') ? (int)FUNC1 : (int)UNIOP) )
#define UNIBRACK(f) return(yylval.ival = f, \
- REPORT("uni",f), \
+ REPORT("uni",f) \
PL_bufptr = s, \
PL_last_uni = PL_oldbufptr, \
(*s == '(' || (s = skipspace(s), *s == '(') ? (int)FUNC1 : (int)UNIOP) )
/* grandfather return to old style */
#define OLDLOP(f) return(yylval.ival=f,PL_expect = XTERM,PL_bufptr = s,(int)LSTOP)
-void
+STATIC void
S_tokereport(pTHX_ char *thing, char* s, I32 rv)
{
SV *report;
SAVEPPTR(PL_bufend);
SAVEPPTR(PL_oldbufptr);
SAVEPPTR(PL_oldoldbufptr);
+ SAVEPPTR(PL_last_lop);
+ SAVEPPTR(PL_last_uni);
SAVEPPTR(PL_linestart);
SAVESPTR(PL_linestr);
SAVEPPTR(PL_lex_brackstack);
SvTEMP_off(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 = Nullch;
SvREFCNT_dec(PL_rs);
PL_rs = newSVpvn("\n", 1);
PL_rsfp = 0;
s += 4;
else
return;
- if (*s == ' ' || *s == '\t')
+ if (SPACE_OR_TAB(*s))
s++;
else
return;
PL_oldoldbufptr = PL_oldbufptr = PL_bufptr = s = PL_linestart
= SvPVX(PL_linestr);
PL_bufend = SvPVX(PL_linestr) + SvCUR(PL_linestr);
+ PL_last_lop = PL_last_uni = Nullch;
/* Close the filehandle. Could be from -P preprocessor,
* STDIN, or a regular file. If we were reading code from
{
yylval.ival = f;
CLINE;
- REPORT("lop", f);
+ REPORT("lop", f)
PL_expect = x;
PL_bufptr = s;
PL_last_lop = PL_oldbufptr;
SAVEPPTR(PL_bufptr);
SAVEPPTR(PL_oldbufptr);
SAVEPPTR(PL_oldoldbufptr);
+ SAVEPPTR(PL_last_lop);
+ SAVEPPTR(PL_last_uni);
SAVEPPTR(PL_linestart);
SAVESPTR(PL_linestr);
SAVEPPTR(PL_lex_brackstack);
PL_bufend = PL_bufptr = PL_oldbufptr = PL_oldoldbufptr = PL_linestart
= SvPVX(PL_linestr);
PL_bufend += SvCUR(PL_linestr);
+ PL_last_lop = PL_last_uni = Nullch;
SAVEFREESV(PL_linestr);
PL_lex_dojoin = FALSE;
PL_lex_inpat = 0;
PL_bufend = PL_bufptr = PL_oldbufptr = PL_oldoldbufptr = PL_linestart = SvPVX(PL_linestr);
PL_bufend += SvCUR(PL_linestr);
+ PL_last_lop = PL_last_uni = Nullch;
SAVEFREESV(PL_linestr);
PL_lex_dojoin = FALSE;
PL_lex_brackets = 0;
I32 min; /* first character in range */
I32 max; /* last character in range */
+ if (utf) {
+ char *c = (char*)utf8_hop((U8*)d, -1);
+ char *e = d++;
+ while (e-- > c)
+ *(e + 1) = *e;
+ *c = (char)0xff;
+ /* mark the range as done, and continue */
+ dorange = FALSE;
+ didrange = TRUE;
+ continue;
+ }
i = d - SvPVX(sv); /* remember current offset */
SvGROW(sv, SvLEN(sv) + 256); /* never more than 256 chars in a range */
d = SvPVX(sv) + i; /* refresh d after realloc */
char *src, *dst;
d = SvGROW(sv,
- SvCUR(sv) + hicount + 1) +
+ SvLEN(sv) + hicount + 1) +
(d - old_pvx);
src = d - 1;
if (len > e - s + 4) {
char *odest = SvPVX(sv);
- SvGROW(sv, (SvCUR(sv) + len - (e - s + 4)));
+ SvGROW(sv, (SvLEN(sv) + len - (e - s + 4)));
d = SvPVX(sv) + (d - odest);
}
Copy(str, d, len, char);
*/
#ifdef USE_PURE_BISON
-#ifdef __SC__
-#pragma segment Perl_yylex_r
-#endif
int
Perl_yylex_r(pTHX_ YYSTYPE *lvalp, int *lcharp)
{
sv_catpv(PL_linestr, "\n");
PL_oldoldbufptr = PL_oldbufptr = s = PL_linestart = SvPVX(PL_linestr);
PL_bufend = SvPVX(PL_linestr) + SvCUR(PL_linestr);
+ PL_last_lop = PL_last_uni = Nullch;
if (PERLDB_LINE && PL_curstash != PL_debstash) {
SV *sv = NEWSV(85,0);
sv_catpv(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 = Nullch;
PL_minus_n = PL_minus_p = 0;
goto retry;
}
PL_oldoldbufptr = PL_oldbufptr = s = PL_linestart = SvPVX(PL_linestr);
+ PL_last_lop = PL_last_uni = Nullch;
sv_setpv(PL_linestr,"");
TOKEN(';'); /* not infinite loop because rsfp is NULL now */
}
sv_setpv(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 = Nullch;
PL_doextract = FALSE;
}
}
av_store(CopFILEAV(PL_curcop),(I32)CopLINE(PL_curcop),sv);
}
PL_bufend = SvPVX(PL_linestr) + SvCUR(PL_linestr);
+ PL_last_lop = PL_last_uni = Nullch;
if (CopLINE(PL_curcop) == 1) {
while (s < PL_bufend && isSPACE(*s))
s++;
sv_setpv(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 = Nullch;
PL_preambled = FALSE;
if (PERLDB_LINE)
(void)gv_fetchfile(PL_origfilename);
if (*d == '(') {
d = scan_str(d,TRUE,TRUE);
if (!d) {
- if (PL_lex_stuff) {
- SvREFCNT_dec(PL_lex_stuff);
- PL_lex_stuff = Nullsv;
- }
/* MUST advance bufptr here to avoid bogus
"at end of line" context messages from yyerror().
*/
CvLOCKED_on(PL_compcv);
else if (!PL_in_my && len == 6 && strnEQ(s, "method", len))
CvMETHOD_on(PL_compcv);
+#ifdef USE_ITHREADS
+ else if (PL_in_my == KEY_our && len == 6 && strnEQ(s, "shared", len))
+ GvSHARED_on(cGVOPx_gv(yylval.opval));
+#endif
/* After we've set the flags, it could be argued that
we don't need to do the attributes.pm-based setting
process, and shouldn't bother appending recognized
flags. To experiment with that, uncomment the
following "else": */
- /* else */
+ else
attrs = append_elem(OP_LIST, attrs,
newSVOP(OP_CONST, 0,
newSVpvn(s, len)));
if (*d == '}') {
char minus = (PL_tokenbuf[0] == '-');
s = force_word(s + minus, WORD, FALSE, TRUE, FALSE);
- if (UTF && !IN_BYTE && is_utf8_string((U8*)PL_tokenbuf, 0) &&
- PL_nextval[PL_nexttoke-1].opval)
- SvUTF8_on(((SVOP*)PL_nextval[PL_nexttoke-1].opval)->op_sv);
if (minus)
force_next('-');
}
case '\'':
s = scan_str(s,FALSE,FALSE);
DEBUG_T( { PerlIO_printf(Perl_debug_log,
- "### Saw string in '%s'\n", s);
+ "### Saw string before '%s'\n", s);
} )
if (PL_expect == XOPERATOR) {
if (PL_lex_formbrack && PL_lex_brackets == PL_lex_formbrack) {
case '"':
s = scan_str(s,FALSE,FALSE);
DEBUG_T( { PerlIO_printf(Perl_debug_log,
- "### Saw string in '%s'\n", s);
+ "### Saw string before '%s'\n", s);
} )
if (PL_expect == XOPERATOR) {
if (PL_lex_formbrack && PL_lex_brackets == PL_lex_formbrack) {
case '`':
s = scan_str(s,FALSE,FALSE);
DEBUG_T( { PerlIO_printf(Perl_debug_log,
- "### Saw backtick string in '%s'\n", s);
+ "### Saw backtick string before '%s'\n", s);
} )
if (PL_expect == XOPERATOR)
no_op("Backticks",s);
force_next(THING);
}
}
- if (PL_lex_stuff)
+ if (PL_lex_stuff) {
SvREFCNT_dec(PL_lex_stuff);
- PL_lex_stuff = Nullsv;
+ PL_lex_stuff = Nullsv;
+ }
PL_expect = XTERM;
TOKEN('(');
case KEY_qq:
- case KEY_qu:
s = scan_str(s,FALSE,FALSE);
- if (tmp == KEY_qu &&
- is_utf8_string((U8*)SvPVX(PL_lex_stuff), SvCUR(PL_lex_stuff)))
- SvUTF8_on(PL_lex_stuff);
if (!s)
missingterm((char*)0);
yylval.ival = OP_STRINGIFY;
char *p;
s = scan_str(s,FALSE,FALSE);
- if (!s) {
- if (PL_lex_stuff)
- SvREFCNT_dec(PL_lex_stuff);
- PL_lex_stuff = Nullsv;
+ if (!s)
Perl_croak(aTHX_ "Prototype not terminated");
- }
/* strip spaces */
d = SvPVX(PL_lex_stuff);
tmp = 0;
if (strEQ(d,"q")) return KEY_q;
if (strEQ(d,"qr")) return KEY_qr;
if (strEQ(d,"qq")) return KEY_qq;
- if (strEQ(d,"qu")) return KEY_qu;
if (strEQ(d,"qw")) return KEY_qw;
if (strEQ(d,"qx")) return KEY_qx;
}
char *s;
s = scan_str(start,FALSE,FALSE);
- if (!s) {
- if (PL_lex_stuff)
- SvREFCNT_dec(PL_lex_stuff);
- PL_lex_stuff = Nullsv;
+ if (!s)
Perl_croak(aTHX_ "Search pattern not terminated");
- }
pm = (PMOP*)newPMOP(type, 0);
if (PL_multi_open == '?')
s = scan_str(start,FALSE,FALSE);
- if (!s) {
- if (PL_lex_stuff)
- SvREFCNT_dec(PL_lex_stuff);
- PL_lex_stuff = Nullsv;
+ if (!s)
Perl_croak(aTHX_ "Substitution pattern not terminated");
- }
if (s[-1] == PL_multi_open)
s--;
first_start = PL_multi_start;
s = scan_str(s,FALSE,FALSE);
if (!s) {
- if (PL_lex_stuff)
+ if (PL_lex_stuff) {
SvREFCNT_dec(PL_lex_stuff);
- PL_lex_stuff = Nullsv;
- if (PL_lex_repl)
- SvREFCNT_dec(PL_lex_repl);
- PL_lex_repl = Nullsv;
+ PL_lex_stuff = Nullsv;
+ }
Perl_croak(aTHX_ "Substitution replacement not terminated");
}
PL_multi_start = first_start; /* so whole substitution is taken together */
I32 squash;
I32 del;
I32 complement;
- I32 utf8;
- I32 count = 0;
yylval.ival = OP_NULL;
s = scan_str(start,FALSE,FALSE);
- if (!s) {
- if (PL_lex_stuff)
- SvREFCNT_dec(PL_lex_stuff);
- PL_lex_stuff = Nullsv;
+ if (!s)
Perl_croak(aTHX_ "Transliteration pattern not terminated");
- }
if (s[-1] == PL_multi_open)
s--;
s = scan_str(s,FALSE,FALSE);
if (!s) {
- if (PL_lex_stuff)
+ if (PL_lex_stuff) {
SvREFCNT_dec(PL_lex_stuff);
- PL_lex_stuff = Nullsv;
- if (PL_lex_repl)
- SvREFCNT_dec(PL_lex_repl);
- PL_lex_repl = Nullsv;
+ PL_lex_stuff = Nullsv;
+ }
Perl_croak(aTHX_ "Transliteration replacement not terminated");
}
- New(803,tbl,256,short);
- o = newPVOP(OP_TRANS, 0, (char*)tbl);
-
complement = del = squash = 0;
while (strchr("cds", *s)) {
if (*s == 'c')
squash = OPpTRANS_SQUASH;
s++;
}
+
+ New(803, tbl, complement&&!del?258:256, short);
+ o = newPVOP(OP_TRANS, 0, (char*)tbl);
o->op_private = del|squash|complement|
(DO_UTF8(PL_lex_stuff)? OPpTRANS_FROM_UTF : 0)|
(DO_UTF8(PL_lex_repl) ? OPpTRANS_TO_UTF : 0);
sv_setsv(PL_linestr,herewas);
PL_oldoldbufptr = PL_oldbufptr = PL_bufptr = s = PL_linestart = SvPVX(PL_linestr);
PL_bufend = SvPVX(PL_linestr) + SvCUR(PL_linestr);
+ PL_last_lop = PL_last_uni = Nullch;
}
else
sv_setpvn(tmpstr,"",0); /* avoid "uninitialized" warning */
}
CopLINE_inc(PL_curcop);
PL_bufend = SvPVX(PL_linestr) + SvCUR(PL_linestr);
+ PL_last_lop = PL_last_uni = Nullch;
#ifndef PERL_STRICT_CR
if (PL_bufend - PL_linestart >= 2) {
if ((PL_bufend[-2] == '\r' && PL_bufend[-1] == '\n') ||
delimiter. It allows quoting of delimiters, and if the string has
balanced delimiters ([{<>}]) it allows nesting.
- The lexer always reads these strings into lex_stuff, except in the
- case of the operators which take *two* arguments (s/// and tr///)
- when it checks to see if lex_stuff is full (presumably with the 1st
- arg to s or tr) and if so puts the string into lex_repl.
-
+ On success, the SV with the resulting string is put into lex_stuff or,
+ if that is already non-NULL, into lex_repl. The second case occurs only
+ when parsing the RHS of the special constructs s/// and tr/// (y///).
+ For convenience, the terminating delimiter character is stuffed into
+ SvIVX of the SV.
*/
STATIC char *
/* having changed the buffer, we must update PL_bufend */
PL_bufend = SvPVX(PL_linestr) + SvCUR(PL_linestr);
+ PL_last_lop = PL_last_uni = Nullch;
}
/* at this point, we have successfully read the delimited string */
s = filter_gets(PL_linestr, PL_rsfp, 0);
PL_oldoldbufptr = PL_oldbufptr = PL_bufptr = PL_linestart = SvPVX(PL_linestr);
PL_bufend = PL_bufptr + SvCUR(PL_linestr);
+ PL_last_lop = PL_last_uni = Nullch;
if (!s) {
s = PL_bufptr;
yyerror("Format not terminated");
return oldsavestack_ix;
}
+#ifdef __SC__
+#pragma segment Perl_yylex
+#endif
int
Perl_yywarn(pTHX_ char *s)
{
PL_in_my_stash = Nullhv;
return 0;
}
+#ifdef __SC__
+#pragma segment Main
+#endif
STATIC char*
S_swallow_bom(pTHX_ U8 *s)