#ifdef CLINE
#undef CLINE
#endif
-#define CLINE (PL_copline = (PL_curcop->cop_line < PL_copline ? PL_curcop->cop_line : PL_copline))
+#define CLINE (PL_copline = (CopLINE(PL_curcop) < PL_copline ? CopLINE(PL_curcop) : PL_copline))
/*
* Convenience functions to return different tokens and prime the
SAVEI32(PL_lex_state);
SAVESPTR(PL_lex_inpat);
SAVEI32(PL_lex_inwhat);
- SAVEI16(PL_curcop->cop_line);
+ SAVECOPLINE(PL_curcop);
SAVEPPTR(PL_bufptr);
SAVEPPTR(PL_bufend);
SAVEPPTR(PL_oldbufptr);
* S_incline
* This subroutine has nothing to do with tilting, whether at windmills
* or pinball tables. Its name is short for "increment line". It
- * increments the current line number in PL_curcop->cop_line and checks
+ * increments the current line number in CopLINE(PL_curcop) and checks
* to see whether the line starts with a comment of the form
* # line 500 "foo.pm"
* If so, it sets the current line number and file to the values in the comment.
char ch;
int sawline = 0;
- PL_curcop->cop_line++;
+ CopLINE_inc(PL_curcop);
if (*s++ != '#')
return;
while (*s == ' ' || *s == '\t') s++;
ch = *t;
*t = '\0';
if (t - s > 0)
- CopFILEGV_set(PL_curcop, gv_fetchfile(s));
+ CopFILE_set(PL_curcop, s);
else
- CopFILEGV_set(PL_curcop, gv_fetchfile(PL_origfilename));
+ CopFILE_set(PL_curcop, PL_origfilename);
*t = ch;
- PL_curcop->cop_line = atoi(n)-1;
+ CopLINE_set(PL_curcop, atoi(n)-1);
}
/*
sv_upgrade(sv, SVt_PVMG);
sv_setpvn(sv,PL_bufptr,PL_bufend-PL_bufptr);
- av_store(CopFILEAV(PL_curcop),(I32)PL_curcop->cop_line,sv);
+ av_store(CopFILEAV(PL_curcop),(I32)CopLINE(PL_curcop),sv);
}
}
}
SAVEI32(PL_lex_state);
SAVESPTR(PL_lex_inpat);
SAVEI32(PL_lex_inwhat);
- SAVEI16(PL_curcop->cop_line);
+ SAVECOPLINE(PL_curcop);
SAVEPPTR(PL_bufptr);
SAVEPPTR(PL_oldbufptr);
SAVEPPTR(PL_oldoldbufptr);
*PL_lex_casestack = '\0';
PL_lex_starts = 0;
PL_lex_state = LEX_INTERPCONCAT;
- PL_curcop->cop_line = PL_multi_start;
+ CopLINE_set(PL_curcop, PL_multi_start);
PL_lex_inwhat = PL_sublex_info.sub_inwhat;
if (PL_lex_inwhat == OP_MATCH || PL_lex_inwhat == OP_QR || PL_lex_inwhat == OP_SUBST)
* store private buffers and state information.
*
* The supplied datasv parameter is upgraded to a PVIO type
- * and the IoDIRP field is used to store the function pointer.
+ * and the IoDIRP field is used to store the function pointer,
+ * and IOf_FAKE_DIRP is enabled on datasv to mark this as such.
* Note that IoTOP_NAME, IoFMT_NAME, IoBOTTOM_NAME, if set for
* private use must be set using malloc'd pointers.
*/
if (!SvUPGRADE(datasv, SVt_PVIO))
Perl_die(aTHX_ "Can't upgrade filter_add data to SVt_PVIO");
IoDIRP(datasv) = (DIR*)funcp; /* stash funcp into spare field */
+ IoFLAGS(datasv) |= IOf_FAKE_DIRP;
DEBUG_P(PerlIO_printf(Perl_debug_log, "filter_add func %p (%s)\n",
funcp, SvPV_nolen(datasv)));
av_unshift(PL_rsfp_filters, 1);
void
Perl_filter_del(pTHX_ filter_t funcp)
{
+ SV *datasv;
DEBUG_P(PerlIO_printf(Perl_debug_log, "filter_del func %p", funcp));
if (!PL_rsfp_filters || AvFILLp(PL_rsfp_filters)<0)
return;
/* if filter is on top of stack (usual case) just pop it off */
- if (IoDIRP(FILTER_DATA(AvFILLp(PL_rsfp_filters))) == (DIR*)funcp){
- IoDIRP(FILTER_DATA(AvFILLp(PL_rsfp_filters))) = NULL;
+ datasv = FILTER_DATA(AvFILLp(PL_rsfp_filters));
+ if (IoDIRP(datasv) == (DIR*)funcp) {
+ IoFLAGS(datasv) &= ~IOf_FAKE_DIRP;
+ IoDIRP(datasv) = (DIR*)NULL;
sv_free(av_pop(PL_rsfp_filters));
return;
sv_upgrade(sv, SVt_PVMG);
sv_setsv(sv,PL_linestr);
- av_store(CopFILEAV(PL_curcop),(I32)PL_curcop->cop_line,sv);
+ av_store(CopFILEAV(PL_curcop),(I32)CopLINE(PL_curcop),sv);
}
goto retry;
}
sv_upgrade(sv, SVt_PVMG);
sv_setsv(sv,PL_linestr);
- av_store(CopFILEAV(PL_curcop),(I32)PL_curcop->cop_line,sv);
+ av_store(CopFILEAV(PL_curcop),(I32)CopLINE(PL_curcop),sv);
}
PL_bufend = SvPVX(PL_linestr) + SvCUR(PL_linestr);
- if (PL_curcop->cop_line == 1) {
+ if (CopLINE(PL_curcop) == 1) {
while (s < PL_bufend && isSPACE(*s))
s++;
if (*s == ':' && s[1] != ':') /* for csh execing sh scripts */
PL_expect = XTERM;
TOKEN('(');
case ';':
- if (PL_curcop->cop_line < PL_copline)
- PL_copline = PL_curcop->cop_line;
+ if (CopLINE(PL_curcop) < PL_copline)
+ PL_copline = CopLINE(PL_curcop);
tmp = *s++;
OPERATOR(tmp);
case ')':
}
break;
}
- yylval.ival = PL_curcop->cop_line;
+ yylval.ival = CopLINE(PL_curcop);
if (isSPACE(*s) || *s == '#')
PL_copline = NOLINE; /* invalidate current command line number */
TOKEN('{');
s--;
if (PL_expect == XOPERATOR) {
if (ckWARN(WARN_SEMICOLON) && isIDFIRST_lazy(s) && PL_bufptr == PL_linestart) {
- PL_curcop->cop_line--;
+ CopLINE_dec(PL_curcop);
Perl_warner(aTHX_ WARN_SEMICOLON, PL_warn_nosemi);
- PL_curcop->cop_line++;
+ CopLINE_inc(PL_curcop);
}
BAop(OP_BIT_AND);
}
if (PL_expect == XOPERATOR) {
if (PL_bufptr == PL_linestart) {
- PL_curcop->cop_line--;
+ CopLINE_dec(PL_curcop);
Perl_warner(aTHX_ WARN_SEMICOLON, PL_warn_nosemi);
- PL_curcop->cop_line++;
+ CopLINE_inc(PL_curcop);
}
else
no_op("Bareword",s);
case KEY___LINE__:
yylval.opval = (OP*)newSVOP(OP_CONST, 0,
- Perl_newSVpvf(aTHX_ "%"IVdf, (IV)PL_curcop->cop_line));
+ Perl_newSVpvf(aTHX_ "%"IVdf, (IV)CopLINE(PL_curcop)));
TERM(THING);
case KEY___PACKAGE__:
case KEY_DESTROY:
case KEY_BEGIN:
case KEY_END:
+ case KEY_STOP:
case KEY_INIT:
if (PL_expect == XSTATE) {
s = PL_bufptr;
PREBLOCK(ELSE);
case KEY_elsif:
- yylval.ival = PL_curcop->cop_line;
+ yylval.ival = CopLINE(PL_curcop);
OPERATOR(ELSIF);
case KEY_eq:
case KEY_for:
case KEY_foreach:
- yylval.ival = PL_curcop->cop_line;
+ yylval.ival = CopLINE(PL_curcop);
s = skipspace(s);
if (PL_expect == XSTATE && isIDFIRST_lazy(s)) {
char *p = s;
UNI(OP_HEX);
case KEY_if:
- yylval.ival = PL_curcop->cop_line;
+ yylval.ival = CopLINE(PL_curcop);
OPERATOR(IF);
case KEY_index:
UNI(OP_UNTIE);
case KEY_until:
- yylval.ival = PL_curcop->cop_line;
+ yylval.ival = CopLINE(PL_curcop);
OPERATOR(UNTIL);
case KEY_unless:
- yylval.ival = PL_curcop->cop_line;
+ yylval.ival = CopLINE(PL_curcop);
OPERATOR(UNLESS);
case KEY_unlink:
LOP(OP_VEC,XTERM);
case KEY_while:
- yylval.ival = PL_curcop->cop_line;
+ yylval.ival = CopLINE(PL_curcop);
OPERATOR(WHILE);
case KEY_warn:
break;
}
break;
+ case 'S':
+ if (strEQ(d,"STOP")) return KEY_STOP;
+ break;
case 's':
switch (d[1]) {
case 0: return KEY_s;
}
CLINE;
- PL_multi_start = PL_curcop->cop_line;
+ PL_multi_start = CopLINE(PL_curcop);
PL_multi_open = PL_multi_close = '<';
term = *PL_tokenbuf;
if (PL_lex_inwhat == OP_SUBST && PL_in_eval && !PL_rsfp) {
while (s < bufend &&
(*s != term || memNE(s,PL_tokenbuf,len)) ) {
if (*s++ == '\n')
- PL_curcop->cop_line++;
+ CopLINE_inc(PL_curcop);
}
if (s >= bufend) {
- PL_curcop->cop_line = PL_multi_start;
+ CopLINE_set(PL_curcop, PL_multi_start);
missingterm(PL_tokenbuf);
}
sv_setpvn(herewas,bufptr,d-bufptr+1);
while (s < PL_bufend &&
(*s != term || memNE(s,PL_tokenbuf,len)) ) {
if (*s++ == '\n')
- PL_curcop->cop_line++;
+ CopLINE_inc(PL_curcop);
}
if (s >= PL_bufend) {
- PL_curcop->cop_line = PL_multi_start;
+ CopLINE_set(PL_curcop, PL_multi_start);
missingterm(PL_tokenbuf);
}
sv_setpvn(tmpstr,d+1,s-d);
s += len - 1;
- PL_curcop->cop_line++; /* the preceding stmt passes a newline */
+ CopLINE_inc(PL_curcop); /* the preceding stmt passes a newline */
sv_catpvn(herewas,s,PL_bufend-s);
sv_setsv(PL_linestr,herewas);
while (s >= PL_bufend) { /* multiple line string? */
if (!outer ||
!(PL_oldoldbufptr = PL_oldbufptr = s = PL_linestart = filter_gets(PL_linestr, PL_rsfp, 0))) {
- PL_curcop->cop_line = PL_multi_start;
+ CopLINE_set(PL_curcop, PL_multi_start);
missingterm(PL_tokenbuf);
}
- PL_curcop->cop_line++;
+ CopLINE_inc(PL_curcop);
PL_bufend = SvPVX(PL_linestr) + SvCUR(PL_linestr);
#ifndef PERL_STRICT_CR
if (PL_bufend - PL_linestart >= 2) {
sv_upgrade(sv, SVt_PVMG);
sv_setsv(sv,PL_linestr);
- av_store(CopFILEAV(PL_curcop), (I32)PL_curcop->cop_line,sv);
+ av_store(CopFILEAV(PL_curcop), (I32)CopLINE(PL_curcop),sv);
}
if (*s == term && memEQ(s,PL_tokenbuf,len)) {
s = PL_bufend - 1;
}
s++;
retval:
- PL_multi_end = PL_curcop->cop_line;
+ PL_multi_end = CopLINE(PL_curcop);
if (SvCUR(tmpstr) + 5 < SvLEN(tmpstr)) {
SvLEN_set(tmpstr, SvCUR(tmpstr) + 1);
Renew(SvPVX(tmpstr), SvLEN(tmpstr), char);
/* after skipping whitespace, the next character is the terminator */
term = *s;
/* mark where we are */
- PL_multi_start = PL_curcop->cop_line;
+ PL_multi_start = CopLINE(PL_curcop);
PL_multi_open = term;
/* find corresponding closing delimiter */
for (; s < PL_bufend; s++,to++) {
/* embedded newlines increment the current line number */
if (*s == '\n' && !PL_rsfp)
- PL_curcop->cop_line++;
+ CopLINE_inc(PL_curcop);
/* handle quoted delimiters */
if (*s == '\\' && s+1 < PL_bufend && term != '\\') {
if (!keep_quoted && s[1] == term)
for (; s < PL_bufend; s++,to++) {
/* embedded newlines increment the line count */
if (*s == '\n' && !PL_rsfp)
- PL_curcop->cop_line++;
+ CopLINE_inc(PL_curcop);
/* backslashes can escape the open or closing characters */
if (*s == '\\' && s+1 < PL_bufend) {
if (!keep_quoted &&
if (!PL_rsfp ||
!(PL_oldoldbufptr = PL_oldbufptr = s = PL_linestart = filter_gets(PL_linestr, PL_rsfp, 0))) {
sv_free(sv);
- PL_curcop->cop_line = PL_multi_start;
+ CopLINE_set(PL_curcop, PL_multi_start);
return Nullch;
}
/* we read a line, so increment our line counter */
- PL_curcop->cop_line++;
+ CopLINE_inc(PL_curcop);
/* update debugger info */
if (PERLDB_LINE && PL_curstash != PL_debstash) {
sv_upgrade(sv, SVt_PVMG);
sv_setsv(sv,PL_linestr);
- av_store(CopFILEAV(PL_curcop), (I32)PL_curcop->cop_line, sv);
+ av_store(CopFILEAV(PL_curcop), (I32)CopLINE(PL_curcop), sv);
}
/* having changed the buffer, we must update PL_bufend */
if (keep_delims)
sv_catpvn(sv, s, 1);
- PL_multi_end = PL_curcop->cop_line;
+ PL_multi_end = CopLINE(PL_curcop);
s++;
/* if we allocated too much space, give some back */
PL_comppad_name_fill = 0;
PL_min_intro_pending = 0;
PL_padix = 0;
- PL_subline = PL_curcop->cop_line;
+ PL_subline = CopLINE(PL_curcop);
#ifdef USE_THREADS
av_store(PL_comppad_name, 0, newSVpvn("@_", 2));
PL_curpad[0] = (SV*)newAV();
}
msg = sv_2mortal(newSVpv(s, 0));
Perl_sv_catpvf(aTHX_ msg, " at %_ line %"IVdf", ",
- CopFILESV(PL_curcop), (IV)PL_curcop->cop_line);
+ CopFILESV(PL_curcop), (IV)CopLINE(PL_curcop));
if (context)
Perl_sv_catpvf(aTHX_ msg, "near \"%.*s\"\n", contlen, context);
else
Perl_sv_catpvf(aTHX_ msg, "%s\n", where);
- if (PL_multi_start < PL_multi_end && (U32)(PL_curcop->cop_line - PL_multi_end) <= 1) {
+ if (PL_multi_start < PL_multi_end && (U32)(CopLINE(PL_curcop) - PL_multi_end) <= 1) {
Perl_sv_catpvf(aTHX_ msg,
" (Might be a runaway multi-line %c%c string starting on line %"IVdf")\n",
(int)PL_multi_open,(int)PL_multi_close,(IV)PL_multi_start);
projects / p5sagit/p5-mst-13.2.git / blobdiff