/* op.c
*
- * Copyright (c) 1991-2000, Larry Wall
+ * Copyright (c) 1991-2001, Larry Wall
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
SV **svp = AvARRAY(PL_comppad_name);
HV *ourstash = (PL_curstash ? PL_curstash : PL_defstash);
PADOFFSET top = AvFILLp(PL_comppad_name);
- for (off = top; off > PL_comppad_name_floor; off--) {
+ for (off = top; (I32)off > PL_comppad_name_floor; off--) {
if ((sv = svp[off])
&& sv != &PL_sv_undef
&& (SvIVX(sv) == PAD_MAX || SvIVX(sv) == 0)
for (off = AvFILLp(curname); off > 0; off--) {
if ((sv = svp[off]) &&
sv != &PL_sv_undef &&
- seq <= SvIVX(sv) &&
- seq > I_32(SvNVX(sv)) &&
+ seq <= (U32)SvIVX(sv) &&
+ seq > (U32)I_32(SvNVX(sv)) &&
strEQ(SvPVX(sv), name))
{
I32 depth;
switch (CxTYPE(cx)) {
default:
if (i == 0 && saweval) {
- seq = cxstack[saweval].blk_oldcop->cop_seq;
return pad_findlex(name, newoff, seq, PL_main_cv, -1, saweval, 0);
}
break;
case CXt_EVAL:
switch (cx->blk_eval.old_op_type) {
case OP_ENTEREVAL:
- if (CxREALEVAL(cx))
+ if (CxREALEVAL(cx)) {
+ PADOFFSET off;
saweval = i;
+ seq = cxstack[i].blk_oldcop->cop_seq;
+ startcv = cxstack[i].blk_eval.cv;
+ if (startcv && CvOUTSIDE(startcv)) {
+ off = pad_findlex(name, newoff, seq, CvOUTSIDE(startcv),
+ i-1, saweval, 0);
+ if (off) /* continue looking if not found here */
+ return off;
+ }
+ }
break;
case OP_DOFILE:
case OP_REQUIRE:
cv = cx->blk_sub.cv;
if (PL_debstash && CvSTASH(cv) == PL_debstash) { /* ignore DB'* scope */
saweval = i; /* so we know where we were called from */
+ seq = cxstack[i].blk_oldcop->cop_seq;
continue;
}
- seq = cxstack[saweval].blk_oldcop->cop_seq;
return pad_findlex(name, newoff, seq, cv, i-1, saweval,FINDLEX_NOSEARCH);
}
}
if ((sv = svp[off]) &&
sv != &PL_sv_undef &&
(!SvIVX(sv) ||
- (seq <= SvIVX(sv) &&
- seq > I_32(SvNVX(sv)))) &&
+ (seq <= (U32)SvIVX(sv) &&
+ seq > (U32)I_32(SvNVX(sv)))) &&
strEQ(SvPVX(sv), name))
{
if (SvIVX(sv) || SvFLAGS(sv) & SVpad_OUR)
}
type = o->op_type;
if (type == OP_NULL)
- type = o->op_targ;
+ type = (OPCODE)o->op_targ;
/* COP* is not cleared by op_clear() so that we may track line
* numbers etc even after null() */
cSVOPo->op_sv = Nullsv;
#endif
break;
+ case OP_METHOD_NAMED:
case OP_CONST:
SvREFCNT_dec(cSVOPo->op_sv);
cSVOPo->op_sv = Nullsv;
PL_modcount++;
return o;
case OP_CONST:
- if (o->op_private & (OPpCONST_BARE) &&
- !(type == OP_GREPSTART || type == OP_ENTERSUB || type == OP_REFGEN)) {
- SV *sv = ((SVOP*)o)->op_sv;
- GV *gv;
-
- /* Could be a filehandle */
- if (gv = gv_fetchpv(SvPV_nolen(sv), FALSE, SVt_PVIO)) {
- OP* gvio = newUNOP(OP_RV2GV, 0, newGVOP(OP_GV, 0, gv));
- op_free(o);
- o = gvio;
- } else {
- /* OK, it's a sub */
- OP* enter;
- gv = gv_fetchpv(SvPV_nolen(sv), TRUE, SVt_PVCV);
-
- enter = newUNOP(OP_ENTERSUB,0,
- newUNOP(OP_RV2CV, 0,
- newGVOP(OP_GV, 0, gv)
- ));
- enter->op_private |= OPpLVAL_INTRO;
- op_free(o);
- o = enter;
- }
- break;
- }
if (!(o->op_private & (OPpCONST_ARYBASE)))
goto nomod;
if (PL_eval_start && PL_eval_start->op_type == OP_CONST) {
OP* retval = scalarseq(seq);
LEAVE_SCOPE(floor);
PL_pad_reset_pending = FALSE;
- PL_compiling.op_private = PL_hints;
+ PL_compiling.op_private = (U8)(PL_hints & HINT_PRIVATE_MASK);
if (needblockscope)
PL_hints |= HINT_BLOCK_SCOPE; /* propagate out */
pad_leavemy(PL_comppad_name_fill);
case OP_SLE:
case OP_SGE:
case OP_SCMP:
-
- if (o->op_private & OPpLOCALE)
+ /* XXX what about the numeric ops? */
+ if (PL_hints & HINT_LOCALE)
goto nope;
}
OP *
Perl_convert(pTHX_ I32 type, I32 flags, OP *o)
{
- OP *kid;
OP *last = 0;
if (!o || o->op_type != OP_LIST)
if (!(PL_opargs[type] & OA_MARK))
null(cLISTOPo->op_first);
- o->op_type = type;
+ o->op_type = (OPCODE)type;
o->op_ppaddr = PL_ppaddr[type];
o->op_flags |= flags;
if (o->op_type != type)
return o;
- if (cLISTOPo->op_children < 7) {
- /* XXX do we really need to do this if we're done appending?? */
- for (kid = cLISTOPo->op_first; kid; kid = kid->op_sibling)
- last = kid;
- cLISTOPo->op_last = last; /* in case check substituted last arg */
- }
-
return fold_constants(o);
}
((LISTOP*)first)->op_first = last;
}
((LISTOP*)first)->op_last = last;
- ((LISTOP*)first)->op_children++;
return first;
}
first->op_last->op_sibling = last->op_first;
first->op_last = last->op_last;
- first->op_children += last->op_children;
- if (first->op_children)
- first->op_flags |= OPf_KIDS;
-
+ first->op_flags |= (last->op_flags & OPf_KIDS);
+
#ifdef PL_OP_SLAB_ALLOC
#else
Safefree(last);
first->op_sibling = ((LISTOP*)last)->op_first;
((LISTOP*)last)->op_first = first;
}
- ((LISTOP*)last)->op_children++;
+ last->op_flags |= OPf_KIDS;
return last;
}
NewOp(1101, listop, 1, LISTOP);
- listop->op_type = type;
+ listop->op_type = (OPCODE)type;
listop->op_ppaddr = PL_ppaddr[type];
- listop->op_children = (first != 0) + (last != 0);
- listop->op_flags = flags;
+ if (first || last)
+ flags |= OPf_KIDS;
+ listop->op_flags = (U8)flags;
if (!last && first)
last = first;
if (!last)
listop->op_last = pushop;
}
- else if (listop->op_children)
- listop->op_flags |= OPf_KIDS;
return (OP*)listop;
}
{
OP *o;
NewOp(1101, o, 1, OP);
- o->op_type = type;
+ o->op_type = (OPCODE)type;
o->op_ppaddr = PL_ppaddr[type];
- o->op_flags = flags;
+ o->op_flags = (U8)flags;
o->op_next = o;
- o->op_private = 0 + (flags >> 8);
+ o->op_private = (U8)(0 | (flags >> 8));
if (PL_opargs[type] & OA_RETSCALAR)
scalar(o);
if (PL_opargs[type] & OA_TARGET)
first = force_list(first);
NewOp(1101, unop, 1, UNOP);
- unop->op_type = type;
+ unop->op_type = (OPCODE)type;
unop->op_ppaddr = PL_ppaddr[type];
unop->op_first = first;
unop->op_flags = flags | OPf_KIDS;
- unop->op_private = 1 | (flags >> 8);
+ unop->op_private = (U8)(1 | (flags >> 8));
unop = (UNOP*) CHECKOP(type, unop);
if (unop->op_next)
return (OP*)unop;
if (!first)
first = newOP(OP_NULL, 0);
- binop->op_type = type;
+ binop->op_type = (OPCODE)type;
binop->op_ppaddr = PL_ppaddr[type];
binop->op_first = first;
binop->op_flags = flags | OPf_KIDS;
if (!last) {
last = first;
- binop->op_private = 1 | (flags >> 8);
+ binop->op_private = (U8)(1 | (flags >> 8));
}
else {
- binop->op_private = 2 | (flags >> 8);
+ binop->op_private = (U8)(2 | (flags >> 8));
first->op_sibling = last;
}
binop = (BINOP*)CHECKOP(type, binop);
- if (binop->op_next || binop->op_type != type)
+ if (binop->op_next || binop->op_type != (OPCODE)type)
return (OP*)binop;
binop->op_last = binop->op_first->op_sibling;
I32 grows = 0;
register short *tbl;
+ PL_hints |= HINT_BLOCK_SCOPE;
complement = o->op_private & OPpTRANS_COMPLEMENT;
del = o->op_private & OPpTRANS_DELETE;
squash = o->op_private & OPpTRANS_SQUASH;
if (complement) {
U8 tmpbuf[UTF8_MAXLEN+1];
U8** cp;
- I32* cl;
UV nextmin = 0;
New(1109, cp, tlen, U8*);
i = 0;
while (t < tend) {
cp[i++] = t;
t += UTF8SKIP(t);
- if (*t == 0xff) {
+ if (t < tend && *t == 0xff) {
t++;
t += UTF8SKIP(t);
}
qsort(cp, i, sizeof(U8*), utf8compare);
for (j = 0; j < i; j++) {
U8 *s = cp[j];
- I32 cur = j < i ? cp[j+1] - s : tend - s;
+ I32 cur = j < i - 1 ? cp[j+1] - s : tend - s;
UV val = utf8_to_uv(s, cur, &ulen, 0);
s += ulen;
diff = val - nextmin;
sv_catpvn(transv, (char*)tmpbuf, t - tmpbuf);
}
}
- if (*s == 0xff)
+ if (s < tend && *s == 0xff)
val = utf8_to_uv(s+1, cur - 1, &ulen, 0);
if (val >= nextmin)
nextmin = val + 1;
t = (U8*)SvPVX(transv);
tlen = SvCUR(transv);
tend = t + tlen;
+ Safefree(cp);
}
else if (!rlen && !del) {
r = t; rlen = tlen; rend = tend;
else
bits = 8;
+ Safefree(cPVOPo->op_pv);
cSVOPo->op_sv = (SV*)swash_init("utf8", "", listsv, bits, none);
SvREFCNT_dec(listsv);
if (transv)
tbl = (short*)cPVOPo->op_pv;
if (complement) {
Zero(tbl, 256, short);
- for (i = 0; i < tlen; i++)
+ for (i = 0; i < (I32)tlen; i++)
tbl[t[i]] = -1;
for (i = 0, j = 0; i < 256; i++) {
if (!tbl[i]) {
- if (j >= rlen) {
+ if (j >= (I32)rlen) {
if (del)
tbl[i] = -2;
else if (rlen)
tbl[i] = r[j-1];
else
- tbl[i] = i;
+ tbl[i] = (short)i;
}
else {
if (i < 128 && r[j] >= 128)
}
for (i = 0; i < 256; i++)
tbl[i] = -1;
- for (i = 0, j = 0; i < tlen; i++,j++) {
- if (j >= rlen) {
+ for (i = 0, j = 0; i < (I32)tlen; i++,j++) {
+ if (j >= (I32)rlen) {
if (del) {
if (tbl[t[i]] == -1)
tbl[t[i]] = -2;
PMOP *pmop;
NewOp(1101, pmop, 1, PMOP);
- pmop->op_type = type;
+ pmop->op_type = (OPCODE)type;
pmop->op_ppaddr = PL_ppaddr[type];
- pmop->op_flags = flags;
- pmop->op_private = 0 | (flags >> 8);
+ pmop->op_flags = (U8)flags;
+ pmop->op_private = (U8)(0 | (flags >> 8));
if (PL_hints & HINT_RE_TAINT)
pmop->op_pmpermflags |= PMf_RETAINT;
if (pm->op_pmflags & PMf_EVAL) {
curop = 0;
if (CopLINE(PL_curcop) < PL_multi_end)
- CopLINE_set(PL_curcop, PL_multi_end);
+ CopLINE_set(PL_curcop, (line_t)PL_multi_end);
}
#ifdef USE_THREADS
else if (repl->op_type == OP_THREADSV
{
SVOP *svop;
NewOp(1101, svop, 1, SVOP);
- svop->op_type = type;
+ svop->op_type = (OPCODE)type;
svop->op_ppaddr = PL_ppaddr[type];
svop->op_sv = sv;
svop->op_next = (OP*)svop;
- svop->op_flags = flags;
+ svop->op_flags = (U8)flags;
if (PL_opargs[type] & OA_RETSCALAR)
scalar((OP*)svop);
if (PL_opargs[type] & OA_TARGET)
{
PADOP *padop;
NewOp(1101, padop, 1, PADOP);
- padop->op_type = type;
+ padop->op_type = (OPCODE)type;
padop->op_ppaddr = PL_ppaddr[type];
padop->op_padix = pad_alloc(type, SVs_PADTMP);
SvREFCNT_dec(PL_curpad[padop->op_padix]);
PL_curpad[padop->op_padix] = sv;
SvPADTMP_on(sv);
padop->op_next = (OP*)padop;
- padop->op_flags = flags;
+ padop->op_flags = (U8)flags;
if (PL_opargs[type] & OA_RETSCALAR)
scalar((OP*)padop);
if (PL_opargs[type] & OA_TARGET)
{
PVOP *pvop;
NewOp(1101, pvop, 1, PVOP);
- pvop->op_type = type;
+ pvop->op_type = (OPCODE)type;
pvop->op_ppaddr = PL_ppaddr[type];
pvop->op_pv = pv;
pvop->op_next = (OP*)pvop;
- pvop->op_flags = flags;
+ pvop->op_flags = (U8)flags;
if (PL_opargs[type] & OA_RETSCALAR)
scalar((OP*)pvop);
if (PL_opargs[type] & OA_TARGET)
}
curop = list(force_list(left));
o = newBINOP(OP_AASSIGN, flags, list(force_list(right)), curop);
- o->op_private = 0 | (flags >> 8);
+ o->op_private = (U8)(0 | (flags >> 8));
for (curop = ((LISTOP*)curop)->op_first;
curop; curop = curop->op_sibling)
{
if (PL_opargs[curop->op_type] & OA_DANGEROUS) {
if (curop->op_type == OP_GV) {
GV *gv = cGVOPx_gv(curop);
- if (gv == PL_defgv || SvCUR(gv) == PL_generation)
+ if (gv == PL_defgv || (int)SvCUR(gv) == PL_generation)
break;
SvCUR(gv) = PL_generation;
}
curop->op_type == OP_PADANY) {
SV **svp = AvARRAY(PL_comppad_name);
SV *sv = svp[curop->op_targ];
- if (SvCUR(sv) == PL_generation)
+ if ((int)SvCUR(sv) == PL_generation)
break;
SvCUR(sv) = PL_generation; /* (SvCUR not used any more) */
}
#else
GV *gv = (GV*)((PMOP*)curop)->op_pmreplroot;
#endif
- if (gv == PL_defgv || SvCUR(gv) == PL_generation)
+ if (gv == PL_defgv || (int)SvCUR(gv) == PL_generation)
break;
SvCUR(gv) = PL_generation;
}
cop->op_type = OP_NEXTSTATE;
cop->op_ppaddr = PL_ppaddr[ OP_NEXTSTATE ];
}
- cop->op_flags = flags;
- cop->op_private = (PL_hints & HINT_BYTE);
+ cop->op_flags = (U8)flags;
+ cop->op_private = (U8)(PL_hints & (HINT_BYTE|HINT_LOCALE));
#ifdef NATIVE_HINTS
cop->op_private |= NATIVE_HINTS;
#endif
|| k1->op_type == OP_EACH)
{
warnop = ((k1->op_type == OP_NULL)
- ? k1->op_targ : k1->op_type);
+ ? (OPCODE)k1->op_targ : k1->op_type);
}
break;
}
NewOp(1101, logop, 1, LOGOP);
- logop->op_type = type;
+ logop->op_type = (OPCODE)type;
logop->op_ppaddr = PL_ppaddr[type];
logop->op_first = first;
logop->op_flags = flags | OPf_KIDS;
logop->op_other = LINKLIST(other);
- logop->op_private = 1 | (flags >> 8);
+ logop->op_private = (U8)(1 | (flags >> 8));
/* establish postfix order */
logop->op_next = LINKLIST(first);
logop->op_ppaddr = PL_ppaddr[OP_COND_EXPR];
logop->op_first = first;
logop->op_flags = flags | OPf_KIDS;
- logop->op_private = 1 | (flags >> 8);
+ logop->op_private = (U8)(1 | (flags >> 8));
logop->op_other = LINKLIST(trueop);
logop->op_next = LINKLIST(falseop);
range->op_flags = OPf_KIDS;
leftstart = LINKLIST(left);
range->op_other = LINKLIST(right);
- range->op_private = 1 | (flags >> 8);
+ range->op_private = (U8)(1 | (flags >> 8));
left->op_sibling = right;
next = unstack;
cont = append_elem(OP_LINESEQ, cont, unstack);
if ((line_t)whileline != NOLINE) {
- PL_copline = whileline;
+ PL_copline = (line_t)whileline;
cont = append_elem(OP_LINESEQ, cont,
newSTATEOP(0, Nullch, Nullop));
}
redo = LINKLIST(listop);
if (expr) {
- PL_copline = whileline;
+ PL_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)) {
SAVEVPTR(PL_curpad);
PL_curpad = 0;
- if (!CvCLONED(cv))
- op_free(CvROOT(cv));
+ op_free(CvROOT(cv));
CvROOT(cv) = Nullop;
LEAVE;
}
SvPOK_off((SV*)cv); /* forget prototype */
- CvFLAGS(cv) = 0;
- SvREFCNT_dec(CvGV(cv));
CvGV(cv) = Nullgv;
- SvREFCNT_dec(CvOUTSIDE(cv));
+ /* Since closure prototypes have the same lifetime as the containing
+ * CV, they don't hold a refcount on the outside CV. This avoids
+ * the refcount loop between the outer CV (which keeps a refcount to
+ * the closure prototype in the pad entry for pp_anoncode()) and the
+ * closure prototype, and the ensuing memory leak. This does not
+ * apply to closures generated within eval"", since eval"" CVs are
+ * ephemeral. --GSAR */
+ if (!CvANON(cv) || CvCLONED(cv)
+ || (CvOUTSIDE(cv) && SvTYPE(CvOUTSIDE(cv)) == SVt_PVCV
+ && CvEVAL(CvOUTSIDE(cv)) && !CvGV(CvOUTSIDE(cv))))
+ {
+ SvREFCNT_dec(CvOUTSIDE(cv));
+ }
CvOUTSIDE(cv) = Nullcv;
if (CvPADLIST(cv)) {
/* may be during global destruction */
}
CvPADLIST(cv) = Nullav;
}
+ CvFLAGS(cv) = 0;
}
STATIC void
CvOWNER(cv) = 0;
#endif /* USE_THREADS */
CvFILE(cv) = CvFILE(proto);
- CvGV(cv) = (GV*)SvREFCNT_inc(CvGV(proto));
+ CvGV(cv) = CvGV(proto);
CvSTASH(cv) = CvSTASH(proto);
- CvROOT(cv) = CvROOT(proto);
+ CvROOT(cv) = OpREFCNT_inc(CvROOT(proto));
CvSTART(cv) = CvSTART(proto);
if (outside)
CvOUTSIDE(cv) = (CV*)SvREFCNT_inc(outside);
goto done;
}
/* ahem, death to those who redefine active sort subs */
- if (PL_curstackinfo->si_type == PERLSI_SORT && PL_sortcop == CvSTART(cv))
+ if (PL_curstackinfo->si_type == PERLSI_SORT &&
+ PL_sortcop == CvSTART(cv)) {
+ op_free(block);
Perl_croak(aTHX_ "Can't redefine active sort subroutine %s", name);
+ }
if (!block)
goto withattrs;
if ((const_sv = cv_const_sv(cv)))
- const_changed = sv_cmp(const_sv, op_const_sv(block, Nullcv));
+ const_changed = (bool)sv_cmp(const_sv, op_const_sv(block, Nullcv));
if ((const_sv || const_changed) && ckWARN(WARN_REDEFINE))
{
line_t oldline = CopLINE(PL_curcop);
CvOUTSIDE(PL_compcv) = 0;
CvPADLIST(cv) = CvPADLIST(PL_compcv);
CvPADLIST(PL_compcv) = 0;
- if (SvREFCNT(PL_compcv) > 1) /* XXX Make closures transit through stub. */
- CvOUTSIDE(PL_compcv) = (CV*)SvREFCNT_inc((SV*)cv);
+ /* inner references to PL_compcv must be fixed up ... */
+ {
+ AV *padlist = CvPADLIST(cv);
+ AV *comppad_name = (AV*)AvARRAY(padlist)[0];
+ AV *comppad = (AV*)AvARRAY(padlist)[1];
+ SV **namepad = AvARRAY(comppad_name);
+ SV **curpad = AvARRAY(comppad);
+ for (ix = AvFILLp(comppad_name); ix > 0; ix--) {
+ SV *namesv = namepad[ix];
+ if (namesv && namesv != &PL_sv_undef
+ && *SvPVX(namesv) == '&')
+ {
+ CV *innercv = (CV*)curpad[ix];
+ if (CvOUTSIDE(innercv) == PL_compcv) {
+ CvOUTSIDE(innercv) = cv;
+ if (!CvANON(innercv) || CvCLONED(innercv)) {
+ (void)SvREFCNT_inc(cv);
+ SvREFCNT_dec(PL_compcv);
+ }
+ }
+ }
+ }
+ }
+ /* ... before we throw it away */
SvREFCNT_dec(PL_compcv);
}
else {
PL_sub_generation++;
}
}
- CvGV(cv) = (GV*)SvREFCNT_inc(gv);
+ CvGV(cv) = gv;
CvFILE(cv) = CopFILE(PL_curcop);
CvSTASH(cv) = PL_curstash;
#ifdef USE_THREADS
}
}
+ /* If a potential closure prototype, don't keep a refcount on
+ * outer CV, unless the latter happens to be a passing eval"".
+ * This is okay as the lifetime of the prototype is tied to the
+ * lifetime of the outer CV. Avoids memory leak due to reference
+ * loop. --GSAR */
+ if (!name && CvOUTSIDE(cv)
+ && !(SvTYPE(CvOUTSIDE(cv)) == SVt_PVCV
+ && CvEVAL(CvOUTSIDE(cv)) && !CvGV(CvOUTSIDE(cv))))
+ {
+ SvREFCNT_dec(CvOUTSIDE(cv));
+ }
+
if (name || aname) {
char *s;
char *tname = (name ? name : aname);
if (!PL_beginav)
PL_beginav = newAV();
DEBUG_x( dump_sub(gv) );
- av_push(PL_beginav, SvREFCNT_inc(cv));
- GvCV(gv) = 0;
+ av_push(PL_beginav, (SV*)cv);
+ GvCV(gv) = 0; /* cv has been hijacked */
call_list(oldscope, PL_beginav);
PL_curcop = &PL_compiling;
- PL_compiling.op_private = PL_hints;
+ PL_compiling.op_private = (U8)(PL_hints & HINT_PRIVATE_MASK);
LEAVE;
}
else if (strEQ(s, "END") && !PL_error_count) {
PL_endav = newAV();
DEBUG_x( dump_sub(gv) );
av_unshift(PL_endav, 1);
- av_store(PL_endav, 0, SvREFCNT_inc(cv));
- GvCV(gv) = 0;
+ av_store(PL_endav, 0, (SV*)cv);
+ GvCV(gv) = 0; /* cv has been hijacked */
}
else if (strEQ(s, "CHECK") && !PL_error_count) {
if (!PL_checkav)
if (PL_main_start && ckWARN(WARN_VOID))
Perl_warner(aTHX_ WARN_VOID, "Too late to run CHECK block");
av_unshift(PL_checkav, 1);
- av_store(PL_checkav, 0, SvREFCNT_inc(cv));
- GvCV(gv) = 0;
+ av_store(PL_checkav, 0, (SV*)cv);
+ GvCV(gv) = 0; /* cv has been hijacked */
}
else if (strEQ(s, "INIT") && !PL_error_count) {
if (!PL_initav)
DEBUG_x( dump_sub(gv) );
if (PL_main_start && ckWARN(WARN_VOID))
Perl_warner(aTHX_ WARN_VOID, "Too late to run INIT block");
- av_push(PL_initav, SvREFCNT_inc(cv));
- GvCV(gv) = 0;
+ av_push(PL_initav, (SV*)cv);
+ GvCV(gv) = 0; /* cv has been hijacked */
}
}
PL_sub_generation++;
}
}
- CvGV(cv) = (GV*)SvREFCNT_inc(gv);
+ CvGV(cv) = gv;
#ifdef USE_THREADS
New(666, CvMUTEXP(cv), 1, perl_mutex);
MUTEX_INIT(CvMUTEXP(cv));
if (strEQ(s, "BEGIN")) {
if (!PL_beginav)
PL_beginav = newAV();
- av_push(PL_beginav, SvREFCNT_inc(cv));
- GvCV(gv) = 0;
+ av_push(PL_beginav, (SV*)cv);
+ GvCV(gv) = 0; /* cv has been hijacked */
}
else if (strEQ(s, "END")) {
if (!PL_endav)
PL_endav = newAV();
av_unshift(PL_endav, 1);
- av_store(PL_endav, 0, SvREFCNT_inc(cv));
- GvCV(gv) = 0;
+ av_store(PL_endav, 0, (SV*)cv);
+ GvCV(gv) = 0; /* cv has been hijacked */
}
else if (strEQ(s, "CHECK")) {
if (!PL_checkav)
if (PL_main_start && ckWARN(WARN_VOID))
Perl_warner(aTHX_ WARN_VOID, "Too late to run CHECK block");
av_unshift(PL_checkav, 1);
- av_store(PL_checkav, 0, SvREFCNT_inc(cv));
- GvCV(gv) = 0;
+ av_store(PL_checkav, 0, (SV*)cv);
+ GvCV(gv) = 0; /* cv has been hijacked */
}
else if (strEQ(s, "INIT")) {
if (!PL_initav)
PL_initav = newAV();
if (PL_main_start && ckWARN(WARN_VOID))
Perl_warner(aTHX_ WARN_VOID, "Too late to run INIT block");
- av_push(PL_initav, SvREFCNT_inc(cv));
- GvCV(gv) = 0;
+ av_push(PL_initav, (SV*)cv);
+ GvCV(gv) = 0; /* cv has been hijacked */
}
}
else
}
cv = PL_compcv;
GvFORM(gv) = cv;
- CvGV(cv) = (GV*)SvREFCNT_inc(gv);
+ CvGV(cv) = gv;
CvFILE(cv) = CopFILE(PL_curcop);
for (ix = AvFILLp(PL_comppad); ix > 0; ix--) {
OP *
Perl_ck_bitop(pTHX_ OP *o)
{
- o->op_private = PL_hints;
+ o->op_private = (U8)(PL_hints & HINT_PRIVATE_MASK);
return o;
}
else
o = newUNOP(type, 0, newDEFSVOP());
}
-#ifdef USE_LOCALE
- if (type == OP_FTTEXT || type == OP_FTBINARY) {
- o->op_private = 0;
- if (PL_hints & HINT_LOCALE)
- o->op_private |= OPpLOCALE;
- }
-#endif
return o;
}
gv = newGVgen("main");
gv_IOadd(gv);
append_elem(OP_GLOB, o, newGVOP(OP_GV, 0, gv));
+ SvREFCNT_dec((SV*)gv); /* had excess refcnt */
scalarkids(o);
return o;
}
if (!kid)
append_elem(o->op_type, o, newDEFSVOP());
- o = listkids(o);
-
- o->op_private = 0;
-#ifdef USE_LOCALE
- if (PL_hints & HINT_LOCALE)
- o->op_private |= OPpLOCALE;
-#endif
-
- return o;
-}
-
-OP *
-Perl_ck_fun_locale(pTHX_ OP *o)
-{
- o = ck_fun(o);
-
- o->op_private = 0;
-#ifdef USE_LOCALE
- if (PL_hints & HINT_LOCALE)
- o->op_private |= OPpLOCALE;
-#endif
-
- return o;
+ return listkids(o);
}
OP *
}
OP *
-Perl_ck_scmp(pTHX_ OP *o)
-{
- o->op_private = 0;
-#ifdef USE_LOCALE
- if (PL_hints & HINT_LOCALE)
- o->op_private |= OPpLOCALE;
-#endif
-
- return o;
-}
-
-OP *
Perl_ck_match(pTHX_ OP *o)
{
o->op_private |= OPpRUNTIME;
Perl_ck_sort(pTHX_ OP *o)
{
OP *firstkid;
- o->op_private = 0;
-#ifdef USE_LOCALE
- if (PL_hints & HINT_LOCALE)
- o->op_private |= OPpLOCALE;
-#endif
if (o->op_type == OP_SORT && o->op_flags & OPf_STACKED)
simplify_sort(o);
kid = cLISTOPo->op_first->op_sibling;
cLISTOPo->op_first->op_sibling = kid->op_sibling; /* bypass old block */
op_free(kid); /* then delete it */
- cLISTOPo->op_children--;
}
OP *
break;
case OP_ENTERLOOP:
+ case OP_ENTERITER:
o->op_seq = PL_op_seqmax++;
while (cLOOP->op_redoop->op_type == OP_NULL)
cLOOP->op_redoop = cLOOP->op_redoop->op_next;
https://perl5.git.perl.org / perl5.git / blobdiff