X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/38d27505c65e77f92cb8e231db1ac56a3dee8f57..1b59a1329eefc8fe6584a8e8ed841d661ab326b8:/op.c?ds=sidebyside diff --git a/op.c b/op.c index f966018..a9ee2d1 100644 --- a/op.c +++ b/op.c @@ -175,19 +175,6 @@ Perl_Slab_Alloc(pTHX_ size_t sz) || (CvSTART(PL_compcv) && !CvSLABBED(PL_compcv))) return PerlMemShared_calloc(1, sz); -#if defined(USE_ITHREADS) && IVSIZE > U32SIZE && IVSIZE > PTRSIZE - /* Work around a goof with alignment on our part. For sparc32 (and - possibly other architectures), if built with -Duse64bitint, the IV - op_pmoffset in struct pmop should be 8 byte aligned, but the slab - allocator is only providing 4 byte alignment. The real fix is to change - the IV to a type the same size as a pointer, such as size_t, but we - can't do that without breaking the ABI, which is a no-no in a maint - release. So instead, simply allocate struct pmop directly, which will be - suitably aligned: */ - if (sz == sizeof(struct pmop)) - return PerlMemShared_calloc(1, sz); -#endif - /* While the subroutine is under construction, the slabs are accessed via CvSTART(), to avoid needing to expand PVCV by one pointer for something unneeded at runtime. Once a subroutine is constructed, the slabs are @@ -311,7 +298,7 @@ Perl_Slab_to_rw(pTHX_ OPSLAB *const slab) } #else -# define Slab_to_rw(op) +# define Slab_to_rw(op) NOOP #endif /* This cannot possibly be right, but it was copied from the old slab @@ -741,9 +728,8 @@ Perl_op_free(pTHX_ OP *o) if (type == OP_NULL) type = (OPCODE)o->op_targ; - if (o->op_slabbed) { - Slab_to_rw(OpSLAB(o)); - } + if (o->op_slabbed) + Slab_to_rw(OpSLAB(o)); /* COP* is not cleared by op_clear() so that we may track line * numbers etc even after null() */ @@ -1395,29 +1381,16 @@ Perl_scalarvoid(pTHX_ OP *o) else if (SvNIOK(sv) && (SvNV(sv) == 0.0 || SvNV(sv) == 1.0)) useless = NULL; else if (SvPOK(sv)) { - /* perl4's way of mixing documentation and code - (before the invention of POD) was based on a - trick to mix nroff and perl code. The trick was - built upon these three nroff macros being used in - void context. The pink camel has the details in - the script wrapman near page 319. */ - const char * const maybe_macro = SvPVX_const(sv); - if (strnEQ(maybe_macro, "di", 2) || - strnEQ(maybe_macro, "ds", 2) || - strnEQ(maybe_macro, "ig", 2)) - useless = NULL; - else { - SV * const dsv = newSVpvs(""); - useless_sv - = Perl_newSVpvf(aTHX_ - "a constant (%s)", - pv_pretty(dsv, maybe_macro, - SvCUR(sv), 32, NULL, NULL, - PERL_PV_PRETTY_DUMP - | PERL_PV_ESCAPE_NOCLEAR - | PERL_PV_ESCAPE_UNI_DETECT)); - SvREFCNT_dec_NN(dsv); - } + SV * const dsv = newSVpvs(""); + useless_sv + = Perl_newSVpvf(aTHX_ + "a constant (%s)", + pv_pretty(dsv, SvPVX_const(sv), + SvCUR(sv), 32, NULL, NULL, + PERL_PV_PRETTY_DUMP + | PERL_PV_ESCAPE_NOCLEAR + | PERL_PV_ESCAPE_UNI_DETECT)); + SvREFCNT_dec_NN(dsv); } else if (SvOK(sv)) { useless_sv = Perl_newSVpvf(aTHX_ "a constant (%"SVf")", sv); @@ -3372,7 +3345,10 @@ S_fold_constants(pTHX_ OP *o) if (type == OP_RV2GV) newop = newGVOP(OP_GV, 0, MUTABLE_GV(sv)); else + { newop = newSVOP(OP_CONST, OPpCONST_FOLDED<<8, MUTABLE_SV(sv)); + newop->op_folded = 1; + } op_getmad(o,newop,'f'); return newop; @@ -5907,6 +5883,8 @@ S_new_logop(pTHX_ I32 type, I32 flags, OP** firstp, OP** otherp) other->op_flags |= OPf_SPECIAL; else if (other->op_type == OP_CONST) other->op_private |= OPpCONST_FOLDED; + + other->op_folded = 1; return other; } else { @@ -6068,6 +6046,7 @@ Perl_newCONDOP(pTHX_ I32 flags, OP *first, OP *trueop, OP *falseop) live->op_flags |= OPf_SPECIAL; else if (live->op_type == OP_CONST) live->op_private |= OPpCONST_FOLDED; + live->op_folded = 1; return live; } NewOp(1101, logop, 1, LOGOP); @@ -8678,7 +8657,7 @@ Perl_ck_ftst(pTHX_ OP *o) const OPCODE kidtype = kid->op_type; if (kidtype == OP_CONST && (kid->op_private & OPpCONST_BARE) - && !(kid->op_private & OPpCONST_FOLDED)) { + && !kid->op_folded) { OP * const newop = newGVOP(type, OPf_REF, gv_fetchsv(kid->op_sv, GV_ADD, SVt_PVIO)); #ifdef PERL_MAD @@ -9263,7 +9242,7 @@ Perl_ck_listiob(pTHX_ OP *o) kid = kid->op_sibling; else if (kid && !kid->op_sibling) { /* print HANDLE; */ if (kid->op_type == OP_CONST && kid->op_private & OPpCONST_BARE - && !(kid->op_private & OPpCONST_FOLDED)) { + && !kid->op_folded) { o->op_flags |= OPf_STACKED; /* make it a filehandle */ kid = newUNOP(OP_RV2GV, OPf_REF, scalar(kid)); cLISTOPo->op_first->op_sibling = kid; @@ -10630,8 +10609,8 @@ Perl_ck_trunc(pTHX_ OP *o) if (kid->op_type == OP_NULL) kid = (SVOP*)kid->op_sibling; if (kid && kid->op_type == OP_CONST && - (kid->op_private & (OPpCONST_BARE|OPpCONST_FOLDED)) - == OPpCONST_BARE) + (kid->op_private & OPpCONST_BARE) && + !kid->op_folded) { o->op_flags |= OPf_SPECIAL; kid->op_private &= ~OPpCONST_STRICT; @@ -11980,14 +11959,7 @@ const_sv_xsub(pTHX_ CV* cv) dVAR; dXSARGS; SV *const sv = MUTABLE_SV(XSANY.any_ptr); - if (items != 0) { - NOOP; -#if 0 - /* diag_listed_as: SKIPME */ - Perl_croak(aTHX_ "usage: %s::%s()", - HvNAME_get(GvSTASH(CvGV(cv))), GvNAME(CvGV(cv))); -#endif - } + PERL_UNUSED_ARG(items); if (!sv) { XSRETURN(0); }