static void
S_op_destroy(pTHX_ OP *o)
{
- if (o->op_latefree) {
- o->op_latefreed = 1;
- return;
- }
FreeOp(o);
}
may be freed before their parents. */
if (!o || o->op_type == OP_FREED)
return;
- if (o->op_latefreed) {
- if (o->op_latefree)
- return;
- goto do_free;
- }
type = o->op_type;
if (o->op_private & OPpREFCOUNTED) {
op_free(kid);
}
}
+ if (type == OP_NULL)
+ type = (OPCODE)o->op_targ;
Slab_to_rw(o);
/* COP* is not cleared by op_clear() so that we may track line
* numbers etc even after null() */
- if (type == OP_NEXTSTATE || type == OP_DBSTATE
- || (type == OP_NULL /* the COP might have been null'ed */
- && ((OPCODE)o->op_targ == OP_NEXTSTATE
- || (OPCODE)o->op_targ == OP_DBSTATE))) {
+ if (type == OP_NEXTSTATE || type == OP_DBSTATE) {
cop_free((COP*)o);
}
- if (type == OP_NULL)
- type = (OPCODE)o->op_targ;
-
op_clear(o);
- if (o->op_latefree) {
- o->op_latefreed = 1;
- return;
- }
- do_free:
FreeOp(o);
#ifdef DEBUG_LEAKING_SCALARS
if (PL_op == o)
}
#endif
break;
+ case OP_DUMP:
case OP_GOTO:
case OP_NEXT:
case OP_LAST:
case OP_TRANS:
case OP_TRANSR:
if (o->op_private & (OPpTRANS_FROM_UTF|OPpTRANS_TO_UTF)) {
+ assert(o->op_type == OP_TRANS || o->op_type == OP_TRANSR);
#ifdef USE_ITHREADS
if (cPADOPo->op_padix > 0) {
pad_swipe(cPADOPo->op_padix, TRUE);
o->op_type = (OPCODE)type;
o->op_ppaddr = PL_ppaddr[type];
o->op_flags = (U8)flags;
- o->op_latefree = 0;
- o->op_latefreed = 0;
- o->op_attached = 0;
o->op_next = o;
o->op_private = (U8)(0 | (flags >> 8));
Constructs, checks, and returns a loop-exiting op (such as C<goto>
or C<last>). I<type> is the opcode. I<label> supplies the parameter
determining the target of the op; it is consumed by this function and
-become part of the constructed op tree.
+becomes part of the constructed op tree.
=cut
*/
Perl_newLOOPEX(pTHX_ I32 type, OP *label)
{
dVAR;
- OP *o;
+ OP *o = NULL;
PERL_ARGS_ASSERT_NEWLOOPEX;
if (type != OP_GOTO) {
/* "last()" means "last" */
- if (label->op_type == OP_STUB && (label->op_flags & OPf_PARENS))
+ if (label->op_type == OP_STUB && (label->op_flags & OPf_PARENS)) {
o = newOP(type, OPf_SPECIAL);
- else {
- const_label:
- o = newPVOP(type,
- label->op_type == OP_CONST
- ? SvUTF8(((SVOP*)label)->op_sv)
- : 0,
- savesharedpv(label->op_type == OP_CONST
- ? SvPV_nolen_const(((SVOP*)label)->op_sv)
- : ""));
}
-#ifdef PERL_MAD
- op_getmad(label,o,'L');
-#else
- op_free(label);
-#endif
}
else {
/* Check whether it's going to be a goto &function */
if (label->op_type == OP_ENTERSUB
&& !(label->op_flags & OPf_STACKED))
label = newUNOP(OP_REFGEN, 0, op_lvalue(label, OP_REFGEN));
- else if (label->op_type == OP_CONST) {
+ }
+
+ /* Check for a constant argument */
+ if (label->op_type == OP_CONST) {
SV * const sv = ((SVOP *)label)->op_sv;
STRLEN l;
const char *s = SvPV_const(sv,l);
- if (l == strlen(s)) goto const_label;
- }
- o = newUNOP(type, OPf_STACKED, label);
+ if (l == strlen(s)) {
+ o = newPVOP(type,
+ SvUTF8(((SVOP*)label)->op_sv),
+ savesharedpv(
+ SvPV_nolen_const(((SVOP*)label)->op_sv)));
+ }
}
+
+ /* If we have already created an op, we do not need the label. */
+ if (o)
+#ifdef PERL_MAD
+ op_getmad(label,o,'L');
+#else
+ op_free(label);
+#endif
+ else o = newUNOP(type, OPf_STACKED, label);
+
PL_hints |= HINT_BLOCK_SCOPE;
return o;
}
cv_flags_t existing_builtin_attrs = CvFLAGS(cv) & CVf_BUILTIN_ATTRS;
AV *const temp_av = CvPADLIST(cv);
CV *const temp_cv = CvOUTSIDE(cv);
- const cv_flags_t slabbed = CvSLABBED(cv);
+ const cv_flags_t other_flags =
+ CvFLAGS(cv) & (CVf_SLABBED|CVf_WEAKOUTSIDE);
OP * const cvstart = CvSTART(cv);
- assert(!CvWEAKOUTSIDE(cv));
+ CvGV_set(cv,gv);
assert(!CvCVGV_RC(cv));
assert(CvGV(cv) == gv);
CvPADLIST(PL_compcv) = temp_av;
CvSTART(cv) = CvSTART(PL_compcv);
CvSTART(PL_compcv) = cvstart;
- if (slabbed) CvSLABBED_on(PL_compcv);
- else CvSLABBED_off(PL_compcv);
+ CvFLAGS(PL_compcv) &= ~(CVf_SLABBED|CVf_WEAKOUTSIDE);
+ CvFLAGS(PL_compcv) |= other_flags;
if (CvFILE(cv) && CvDYNFILE(cv)) {
Safefree(CvFILE(cv));
#endif
block = newblock;
}
- else block->op_attached = 1;
CvROOT(cv) = CvLVALUE(cv)
? newUNOP(OP_LEAVESUBLV, 0,
op_lvalue(scalarseq(block), OP_LEAVESUBLV))
SVOP * const kid = (SVOP*)cUNOPo->op_first;
const OPCODE kidtype = kid->op_type;
- if (kidtype == OP_CONST && (kid->op_private & OPpCONST_BARE)) {
+ if (kidtype == OP_CONST && (kid->op_private & OPpCONST_BARE)
+ && !(kid->op_private & OPpCONST_FOLDED)) {
OP * const newop = newGVOP(type, OPf_REF,
gv_fetchsv(kid->op_sv, GV_ADD, SVt_PVIO));
#ifdef PERL_MAD
{
OP * const newop = newUNOP(OP_NULL, 0, kid);
kid->op_sibling = 0;
- LINKLIST(kid);
newop->op_next = newop;
kid = newop;
kid->op_sibling = sibl;
Perl_ck_grep(pTHX_ OP *o)
{
dVAR;
- LOGOP *gwop = NULL;
+ LOGOP *gwop;
OP *kid;
const OPCODE type = o->op_type == OP_GREPSTART ? OP_GREPWHILE : OP_MAPWHILE;
PADOFFSET offset;
/* don't allocate gwop here, as we may leak it if PL_parser->error_count > 0 */
if (o->op_flags & OPf_STACKED) {
- OP *firstkid = cLISTOPo->op_first->op_sibling;
- kid = cUNOPx(firstkid)->op_first;
+ kid = cUNOPx(cLISTOPo->op_first->op_sibling)->op_first;
if (kid->op_type != OP_SCOPE && kid->op_type != OP_LEAVE)
return no_fh_allowed(o);
- LINKLIST(kid);
- firstkid->op_next = kLISTOP->op_first;
- NewOp(1101, gwop, 1, LOGOP);
- kid->op_next = (OP*)gwop;
o->op_flags &= ~OPf_STACKED;
}
kid = cLISTOPo->op_first->op_sibling;
Perl_croak(aTHX_ "panic: ck_grep, type=%u", (unsigned) kid->op_type);
kid = kUNOP->op_first;
- if (!gwop)
- NewOp(1101, gwop, 1, LOGOP);
+ NewOp(1101, gwop, 1, LOGOP);
gwop->op_type = type;
gwop->op_ppaddr = PL_ppaddr[type];
- gwop->op_first = listkids(o);
+ gwop->op_first = o;
gwop->op_flags |= OPf_KIDS;
gwop->op_other = LINKLIST(kid);
kid->op_next = (OP*)gwop;
}
kid = cLISTOPo->op_first->op_sibling;
- if (!kid || !kid->op_sibling)
- return too_few_arguments_pv(o,OP_DESC(o), 0);
for (kid = kid->op_sibling; kid; kid = kid->op_sibling)
op_lvalue(kid, OP_GREPSTART);
}
OP *
-Perl_ck_chdir(pTHX_ OP *o)
-{
- PERL_ARGS_ASSERT_CK_CHDIR;
- if (o->op_flags & OPf_KIDS) {
- SVOP * const kid = (SVOP*)cUNOPo->op_first;
-
- if (kid && kid->op_type == OP_CONST &&
- (kid->op_private & OPpCONST_BARE))
- {
- o->op_flags |= OPf_SPECIAL;
- kid->op_private &= ~OPpCONST_STRICT;
- }
- }
- return ck_fun(o);
-}
-
-OP *
Perl_ck_trunc(pTHX_ OP *o)
{
PERL_ARGS_ASSERT_CK_TRUNC;
if (kid->op_type == OP_NULL)
kid = (SVOP*)kid->op_sibling;
if (kid && kid->op_type == OP_CONST &&
- (kid->op_private & OPpCONST_BARE))
+ (kid->op_private & (OPpCONST_BARE|OPpCONST_FOLDED))
+ == OPpCONST_BARE)
{
o->op_flags |= OPf_SPECIAL;
kid->op_private &= ~OPpCONST_STRICT;
https://perl5.git.perl.org / perl5.git / blobdiff