read only. Also, do it ahead of the loop in case the warn triggers,
and a warn handler has an eval */
- free(PL_slabs);
PL_slabs = NULL;
PL_slab_count = 0;
PL_OpSpace = 0;
while (count--) {
- const void *start = slabs[count];
+ void *const start = slabs[count];
const size_t size = PERL_SLAB_SIZE* sizeof(I32*);
if(mprotect(start, size, PROT_READ)) {
Perl_warn(aTHX_ "mprotect for %p %lu failed with %d",
start, (unsigned long) size, errno);
}
}
+
+ free(slabs);
}
STATIC void
FreeOp(o);
}
+#ifdef USE_ITHREADS
+# define forget_pmop(a,b) S_forget_pmop(aTHX_ a,b)
+#else
+# define forget_pmop(a,b) S_forget_pmop(aTHX_ a)
+#endif
/* Destructor */
}
STATIC void
-S_forget_pmop(pTHX_ PMOP *const o, U32 flags)
+S_forget_pmop(pTHX_ PMOP *const o
+#ifdef USE_ITHREADS
+ , U32 flags
+#endif
+ )
{
HV * const pmstash = PmopSTASH(o);
if (pmstash && !SvIS_FREED(pmstash)) {
}
}
}
+ if (PL_curpm == o)
+ PL_curpm = NULL;
+#ifdef USE_ITHREADS
if (flags)
PmopSTASH_free(o);
+#endif
}
STATIC void
if (ckWARN(WARN_SYNTAX)) {
const line_t oldline = CopLINE(PL_curcop);
- if (PL_copline != NOLINE)
- CopLINE_set(PL_curcop, PL_copline);
+ if (PL_parser && PL_parser->copline != NOLINE)
+ CopLINE_set(PL_curcop, PL_parser->copline);
Perl_warner(aTHX_ packWARN(WARN_SYNTAX), "Found = in conditional, should be ==");
CopLINE_set(PL_curcop, oldline);
}
Perl_croak(aTHX_ "That use of $[ is unsupported");
break;
case OP_STUB:
- if (o->op_flags & OPf_PARENS || PL_madskills)
+ if ((o->op_flags & OPf_PARENS) || PL_madskills)
break;
goto nomod;
case OP_ENTERSUB:
case OP_RECV:
case OP_ANDASSIGN:
case OP_ORASSIGN:
+ case OP_DORASSIGN:
return TRUE;
default:
return FALSE;
/* fake up C<use attributes $pkg,$rv,@attrs> */
ENTER; /* need to protect against side-effects of 'use' */
- SAVEINT(PL_expect);
stashsv = stash ? newSVhek(HvNAME_HEK(stash)) : &PL_sv_no;
#define ATTRSMODULE "attributes"
NOOP;
#endif
else {
- if ( PL_bufptr > PL_oldbufptr && PL_bufptr[-1] == ','
+ if ( PL_parser->bufptr > PL_parser->oldbufptr
+ && PL_parser->bufptr[-1] == ','
&& ckWARN(WARN_PARENTHESIS))
{
- char *s = PL_bufptr;
+ char *s = PL_parser->bufptr;
bool sigil = FALSE;
/* some heuristics to detect a potential error */
return;
if (mp->mad_next)
mad_free(mp->mad_next);
-/* if (PL_lex_state != LEX_NOTPARSING && mp->mad_vlen)
+/* if (PL_parser && PL_parser->lex_state != LEX_NOTPARSING && mp->mad_vlen)
PerlIO_printf(PerlIO_stderr(), "DESTROYING '%c'=<%s>\n", mp->mad_key & 255, mp->mad_val); */
switch (mp->mad_type) {
case MAD_NULL:
}
if (DO_UTF8(pat))
pm_flags |= RXf_UTF8;
- /* FIXME - can we make this function take const char * args? */
- PM_SETRE(pm, CALLREGCOMP((char*)p, (char*)p + plen, pm_flags));
+ PM_SETRE(pm, CALLREGCOMP(pat, pm_flags));
#ifdef PERL_MAD
op_getmad(expr,(OP*)pm,'e');
save_item(PL_curstname);
PL_curstash = gv_stashsv(sv, GV_ADD);
+
sv_setsv(PL_curstname, sv);
PL_hints |= HINT_BLOCK_SCOPE;
- PL_copline = NOLINE;
- PL_expect = XSTATE;
+ PL_parser->copline = NOLINE;
+ PL_parser->expect = XSTATE;
#ifndef PERL_MAD
op_free(o);
*/
PL_hints |= HINT_BLOCK_SCOPE;
- PL_copline = NOLINE;
- PL_expect = XSTATE;
+ PL_parser->copline = NOLINE;
+ PL_parser->expect = XSTATE;
PL_cop_seqmax++; /* Purely for B::*'s benefit */
#ifdef PERL_MAD
sv = va_arg(*args, SV*);
}
}
- {
- const line_t ocopline = PL_copline;
- COP * const ocurcop = PL_curcop;
- const int oexpect = PL_expect;
- utilize(!(flags & PERL_LOADMOD_DENY), start_subparse(FALSE, 0),
- veop, modname, imop);
- PL_expect = oexpect;
- PL_copline = ocopline;
- PL_curcop = ocurcop;
- }
+ /* utilize() fakes up a BEGIN { require ..; import ... }, so make sure
+ * that it has a PL_parser to play with while doing that, and also
+ * that it doesn't mess with any existing parser, by creating a tmp
+ * new parser with lex_start(). This won't actually be used for much,
+ * since pp_require() will create another parser for the real work. */
+
+ ENTER;
+ SAVEVPTR(PL_curcop);
+ lex_start(NULL);
+ utilize(!(flags & PERL_LOADMOD_DENY), start_subparse(FALSE, 0),
+ veop, modname, imop);
+ LEAVE;
}
OP *
o->op_private |= OPpASSIGN_COMMON;
}
- if ( ((left->op_private & OPpLVAL_INTRO) || ckWARN(WARN_MISC))
- && (left->op_type == OP_LIST
- || (left->op_type == OP_NULL && left->op_targ == OP_LIST)))
- {
- OP* lop = ((LISTOP*)left)->op_first;
- while (lop) {
- if (lop->op_type == OP_PADSV ||
- lop->op_type == OP_PADAV ||
- lop->op_type == OP_PADHV ||
- lop->op_type == OP_PADANY)
- {
- if (lop->op_private & OPpPAD_STATE) {
- if (left->op_private & OPpLVAL_INTRO) {
- o->op_private |= OPpASSIGN_STATE;
- /* hijacking PADSTALE for uninitialized state variables */
- SvPADSTALE_on(PAD_SVl(lop->op_targ));
- }
- else { /* we already checked for WARN_MISC before */
- Perl_warner(aTHX_ packWARN(WARN_MISC), "State variable %s will be reinitialized",
- PAD_COMPNAME_PV(lop->op_targ));
- }
- }
- }
- lop = lop->op_sibling;
- }
- }
- else if (((left->op_private & (OPpLVAL_INTRO | OPpPAD_STATE))
- == (OPpLVAL_INTRO | OPpPAD_STATE))
- && ( left->op_type == OP_PADSV
- || left->op_type == OP_PADAV
- || left->op_type == OP_PADHV
- || left->op_type == OP_PADANY))
- {
- o->op_private |= OPpASSIGN_STATE;
- /* hijacking PADSTALE for uninitialized state variables */
- SvPADSTALE_on(PAD_SVl(left->op_targ));
- }
-
if (right && right->op_type == OP_SPLIT) {
OP* tmpop = ((LISTOP*)right)->op_first;
if (tmpop && (tmpop->op_type == OP_PUSHRE)) {
HINTS_REFCNT_UNLOCK;
}
- if (PL_copline == NOLINE)
+ if (PL_parser && PL_parser->copline == NOLINE)
CopLINE_set(cop, CopLINE(PL_curcop));
else {
- CopLINE_set(cop, PL_copline);
- PL_copline = NOLINE;
+ CopLINE_set(cop, PL_parser->copline);
+ if (PL_parser)
+ PL_parser->copline = NOLINE;
}
#ifdef USE_ITHREADS
CopFILE_set(cop, CopFILE(PL_curcop)); /* XXX share in a pvtable? */
}
if (warnop) {
const line_t oldline = CopLINE(PL_curcop);
- CopLINE_set(PL_curcop, PL_copline);
+ CopLINE_set(PL_curcop, PL_parser->copline);
Perl_warner(aTHX_ packWARN(WARN_MISC),
"Value of %s%s can be \"0\"; test with defined()",
PL_op_desc[warnop],
redo = LINKLIST(listop);
if (expr) {
- PL_copline = (line_t)whileline;
+ PL_parser->copline = (line_t)whileline;
scalar(listop);
o = new_logop(OP_AND, 0, &expr, &listop);
if (o == expr && o->op_type == OP_CONST && !SvTRUE(cSVOPo->op_sv)) {
wop = newWHILEOP(flags, 1, loop, forline, newOP(OP_ITER, 0), block, cont, 0);
if (madsv)
op_getmad(madsv, (OP*)loop, 'v');
- PL_copline = forline;
+ PL_parser->copline = forline;
return newSTATEOP(0, label, wop);
}
o = newOP(type, OPf_SPECIAL);
else {
o = newPVOP(type, 0, savesharedpv(label->op_type == OP_CONST
- ? SvPVx_nolen_const(((SVOP*)label)->op_sv)
+ ? SvPV_nolen_const(((SVOP*)label)->op_sv)
: ""));
}
#ifdef PERL_MAD
= (block || attrs || (CvFLAGS(PL_compcv) & CVf_BUILTIN_ATTRS)
|| PL_madskills)
? GV_ADDMULTI : GV_ADDMULTI | GV_NOINIT;
- const char * const name = o ? SvPVx_nolen_const(cSVOPo->op_sv) : NULL;
+ const char * const name = o ? SvPV_nolen_const(cSVOPo->op_sv) : NULL;
if (proto) {
assert(proto->op_type == OP_CONST);
- ps = SvPVx_const(((SVOP*)proto)->op_sv, ps_len);
+ ps = SvPV_const(((SVOP*)proto)->op_sv, ps_len);
}
else
ps = NULL;
sv_setpvn((SV*)gv, ps, ps_len);
else
sv_setiv((SV*)gv, -1);
+
SvREFCNT_dec(PL_compcv);
cv = PL_compcv = NULL;
- PL_sub_generation++;
goto done;
}
&& (!const_sv || sv_cmp(cv_const_sv(cv), const_sv))))
{
const line_t oldline = CopLINE(PL_curcop);
- if (PL_copline != NOLINE)
- CopLINE_set(PL_curcop, PL_copline);
+ if (PL_parser && PL_parser->copline != NOLINE)
+ CopLINE_set(PL_curcop, PL_parser->copline);
Perl_warner(aTHX_ packWARN(WARN_REDEFINE),
CvCONST(cv) ? "Constant subroutine %s redefined"
: "Subroutine %s redefined", name);
GvCV(gv) = NULL;
cv = newCONSTSUB(NULL, name, const_sv);
}
- PL_sub_generation++;
+ mro_method_changed_in( /* sub Foo::Bar () { 123 } */
+ (CvGV(cv) && GvSTASH(CvGV(cv)))
+ ? GvSTASH(CvGV(cv))
+ : CvSTASH(cv)
+ ? CvSTASH(cv)
+ : PL_curstash
+ );
if (PL_madskills)
goto install_block;
op_free(block);
}
}
GvCVGEN(gv) = 0;
- PL_sub_generation++;
+ mro_method_changed_in(GvSTASH(gv)); /* sub Foo::bar { (shift)+1 } */
}
}
CvGV(cv) = gv;
}
done:
- PL_copline = NOLINE;
+ if (PL_parser)
+ PL_parser->copline = NOLINE;
LEAVE_SCOPE(floor);
return cv;
}
ENTER;
SAVECOPLINE(PL_curcop);
- CopLINE_set(PL_curcop, PL_copline);
+ CopLINE_set(PL_curcop, PL_parser ? PL_parser->copline : NOLINE);
SAVEHINTS();
PL_hints &= ~HINT_BLOCK_SCOPE;
const char *redefined_name = HvNAME_get(stash);
if ( strEQ(redefined_name,"autouse") ) {
const line_t oldline = CopLINE(PL_curcop);
- if (PL_copline != NOLINE)
- CopLINE_set(PL_curcop, PL_copline);
+ if (PL_parser && PL_parser->copline != NOLINE)
+ CopLINE_set(PL_curcop, PL_parser->copline);
Perl_warner(aTHX_ packWARN(WARN_REDEFINE),
CvCONST(cv) ? "Constant subroutine %s redefined"
: "Subroutine %s redefined"
if (name) {
GvCV(gv) = cv;
GvCVGEN(gv) = 0;
- PL_sub_generation++;
+ mro_method_changed_in(GvSTASH(gv)); /* newXS */
}
}
CvGV(cv) = gv;
if ((cv = GvFORM(gv))) {
if (ckWARN(WARN_REDEFINE)) {
const line_t oldline = CopLINE(PL_curcop);
- if (PL_copline != NOLINE)
- CopLINE_set(PL_curcop, PL_copline);
+ if (PL_parser && PL_parser->copline != NOLINE)
+ CopLINE_set(PL_curcop, PL_parser->copline);
Perl_warner(aTHX_ packWARN(WARN_REDEFINE),
o ? "Format %"SVf" redefined"
: "Format STDOUT redefined", SVfARG(cSVOPo->op_sv));
#else
op_free(o);
#endif
- PL_copline = NOLINE;
+ if (PL_parser)
+ PL_parser->copline = NOLINE;
LEAVE_SCOPE(floor);
#ifdef PERL_MAD
return pegop;
return kid;
}
}
- if (kid->op_sibling) {
- OP *kkid = kid->op_sibling;
- if (kkid->op_type == OP_PADSV
- && (kkid->op_private & OPpLVAL_INTRO)
- && SvPAD_STATE(*av_fetch(PL_comppad_name, kkid->op_targ, FALSE))) {
- o->op_private |= OPpASSIGN_STATE;
- /* hijacking PADSTALE for uninitialized state variables */
- SvPADSTALE_on(PAD_SVl(kkid->op_targ));
- }
- }
return o;
}