X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=op.c;h=cb868a45009c8dc271d7bb5f452e11b674864bc5;hb=d20626d86bf3d55ba658adbc2678de4c519cbc6c;hp=64d801ff6231cb72fb9316944cdad329ac819f34;hpb=a7089531ba6cec0dc577ea527da80d08bb5964dd;p=p5sagit%2Fp5-mst-13.2.git diff --git a/op.c b/op.c index 64d801f..cb868a4 100644 --- a/op.c +++ b/op.c @@ -21,7 +21,13 @@ #include "keywords.h" /* #define PL_OP_SLAB_ALLOC */ - + +/* XXXXXX testing */ +#define OP_REFCNT_LOCK NOOP +#define OP_REFCNT_UNLOCK NOOP +#define OpREFCNT_set(o,n) NOOP +#define OpREFCNT_dec(o) 0 + #ifdef PL_OP_SLAB_ALLOC #define SLAB_SIZE 8192 static char *PL_OpPtr = NULL; @@ -450,12 +456,14 @@ Perl_pad_alloc(pTHX_ I32 optype, U32 tmptype) SvFLAGS(sv) |= tmptype; PL_curpad = AvARRAY(PL_comppad); #ifdef USE_THREADS - DEBUG_X(PerlIO_printf(Perl_debug_log, "0x%lx Pad 0x%lx alloc %ld for %s\n", - (unsigned long) thr, (unsigned long) PL_curpad, + DEBUG_X(PerlIO_printf(Perl_debug_log, + "0x%"UVxf" Pad 0x%"UVxf" alloc %ld for %s\n", + PTR2UV(thr), PTR2UV(PL_curpad), (long) retval, PL_op_name[optype])); #else - DEBUG_X(PerlIO_printf(Perl_debug_log, "Pad 0x%lx alloc %ld for %s\n", - (unsigned long) PL_curpad, + DEBUG_X(PerlIO_printf(Perl_debug_log, + "Pad 0x%"UVxf" alloc %ld for %s\n", + PTR2UV(PL_curpad), (long) retval, PL_op_name[optype])); #endif /* USE_THREADS */ return (PADOFFSET)retval; @@ -466,13 +474,14 @@ Perl_pad_sv(pTHX_ PADOFFSET po) { dTHR; #ifdef USE_THREADS - DEBUG_X(PerlIO_printf(Perl_debug_log, "0x%lx Pad 0x%lx sv %d\n", - (unsigned long) thr, (unsigned long) PL_curpad, po)); + DEBUG_X(PerlIO_printf(Perl_debug_log, + "0x%"UVxf" Pad 0x%"UVxf" sv %d\n", + PTR2UV(thr), PTR2UV(PL_curpad), po)); #else if (!po) Perl_croak(aTHX_ "panic: pad_sv po"); - DEBUG_X(PerlIO_printf(Perl_debug_log, "Pad 0x%lx sv %d\n", - (unsigned long) PL_curpad, po)); + DEBUG_X(PerlIO_printf(Perl_debug_log, "Pad 0x%"UVxf" sv %d\n", + PTR2UV(PL_curpad), po)); #endif /* USE_THREADS */ return PL_curpad[po]; /* eventually we'll turn this into a macro */ } @@ -488,11 +497,12 @@ Perl_pad_free(pTHX_ PADOFFSET po) if (!po) Perl_croak(aTHX_ "panic: pad_free po"); #ifdef USE_THREADS - DEBUG_X(PerlIO_printf(Perl_debug_log, "0x%lx Pad 0x%lx free %d\n", - (unsigned long) thr, (unsigned long) PL_curpad, po)); + DEBUG_X(PerlIO_printf(Perl_debug_log, + "0x%"UVxf" Pad 0x%"UVxf" free %d\n", + PTR2UV(thr), PTR2UV(PL_curpad), po)); #else - DEBUG_X(PerlIO_printf(Perl_debug_log, "Pad 0x%lx free %d\n", - (unsigned long) PL_curpad, po)); + DEBUG_X(PerlIO_printf(Perl_debug_log, "Pad 0x%"UVxf" free %d\n", + PTR2UV(PL_curpad), po)); #endif /* USE_THREADS */ if (PL_curpad[po] && PL_curpad[po] != &PL_sv_undef) SvPADTMP_off(PL_curpad[po]); @@ -509,11 +519,12 @@ Perl_pad_swipe(pTHX_ PADOFFSET po) if (!po) Perl_croak(aTHX_ "panic: pad_swipe po"); #ifdef USE_THREADS - DEBUG_X(PerlIO_printf(Perl_debug_log, "0x%lx Pad 0x%lx swipe %d\n", - (unsigned long) thr, (unsigned long) PL_curpad, po)); + DEBUG_X(PerlIO_printf(Perl_debug_log, + "0x%"UVxf" Pad 0x%"UVxf" swipe %d\n", + PTR2UV(thr), PTR2UV(PL_curpad), po)); #else - DEBUG_X(PerlIO_printf(Perl_debug_log, "Pad 0x%lx swipe %d\n", - (unsigned long) PL_curpad, po)); + DEBUG_X(PerlIO_printf(Perl_debug_log, "Pad 0x%"UVxf" swipe %d\n", + PTR2UV(PL_curpad), po)); #endif /* USE_THREADS */ SvPADTMP_off(PL_curpad[po]); PL_curpad[po] = NEWSV(1107,0); @@ -538,11 +549,12 @@ Perl_pad_reset(pTHX) if (AvARRAY(PL_comppad) != PL_curpad) Perl_croak(aTHX_ "panic: pad_reset curpad"); #ifdef USE_THREADS - DEBUG_X(PerlIO_printf(Perl_debug_log, "0x%lx Pad 0x%lx reset\n", - (unsigned long) thr, (unsigned long) PL_curpad)); + DEBUG_X(PerlIO_printf(Perl_debug_log, + "0x%"UVxf" Pad 0x%"UVxf" reset\n", + PTR2UV(thr), PTR2UV(PL_curpad))); #else - DEBUG_X(PerlIO_printf(Perl_debug_log, "Pad 0x%lx reset\n", - (unsigned long) PL_curpad)); + DEBUG_X(PerlIO_printf(Perl_debug_log, "Pad 0x%"UVxf" reset\n", + PTR2UV(PL_curpad))); #endif /* USE_THREADS */ if (!PL_tainting) { /* Can't mix tainted and non-tainted temporaries. */ for (po = AvMAX(PL_comppad); po > PL_padix_floor; po--) { @@ -634,6 +646,26 @@ Perl_op_free(pTHX_ OP *o) if (!o || o->op_seq == (U16)-1) return; + if (o->op_private & OPpREFCOUNTED) { + switch (o->op_type) { + case OP_LEAVESUB: + case OP_LEAVESUBLV: + case OP_LEAVEEVAL: + case OP_LEAVE: + case OP_SCOPE: + case OP_LEAVEWRITE: + OP_REFCNT_LOCK; + if (OpREFCNT_dec(o)) { + OP_REFCNT_UNLOCK; + return; + } + OP_REFCNT_UNLOCK; + break; + default: + break; + } + } + if (o->op_flags & OPf_KIDS) { for (kid = cUNOPo->op_first; kid; kid = nextkid) { nextkid = kid->op_sibling; /* Get before next freeing kid */ @@ -685,8 +717,8 @@ S_op_clear(pTHX_ OP *o) case OP_GVSV: case OP_GV: case OP_AELEMFAST: - SvREFCNT_dec(cGVOPo->op_gv); - cGVOPo->op_gv = Nullgv; + SvREFCNT_dec(cSVOPo->op_sv); + cSVOPo->op_sv = Nullsv; break; case OP_CONST: SvREFCNT_dec(cSVOPo->op_sv); @@ -729,7 +761,7 @@ STATIC void S_cop_free(pTHX_ COP* cop) { Safefree(cop->cop_label); - SvREFCNT_dec(cop->cop_filegv); + SvREFCNT_dec(CopFILEGV(cop)); if (! specialWARN(cop->cop_warnings)) SvREFCNT_dec(cop->cop_warnings); } @@ -1325,7 +1357,7 @@ Perl_mod(pTHX_ OP *o, I32 type) break; } - cv = GvCV(kGVOP->op_gv); + cv = GvCV((GV*)kSVOP->op_sv); if (!cv) goto restore_2cv; if (CvLVALUE(cv)) @@ -1810,9 +1842,9 @@ Perl_bind_match(pTHX_ I32 type, OP *left, OP *right) char *desc = PL_op_desc[(right->op_type == OP_SUBST || right->op_type == OP_TRANS) ? right->op_type : OP_MATCH]; - char *sample = ((left->op_type == OP_RV2AV || - left->op_type == OP_PADAV) - ? "@array" : "%hash"); + const char *sample = ((left->op_type == OP_RV2AV || + left->op_type == OP_PADAV) + ? "@array" : "%hash"); Perl_warner(aTHX_ WARN_UNSAFE, "Applying %s to %s will act on scalar(%s)", desc, sample, sample); @@ -1951,6 +1983,8 @@ Perl_newPROG(pTHX_ OP *o) ((PL_in_eval & EVAL_KEEPERR) ? OPf_SPECIAL : 0), o); PL_eval_start = linklist(PL_eval_root); + PL_eval_root->op_private |= OPpREFCOUNTED; + OpREFCNT_set(PL_eval_root, 1); PL_eval_root->op_next = 0; peep(PL_eval_start); } @@ -1960,6 +1994,8 @@ Perl_newPROG(pTHX_ OP *o) PL_main_root = scope(sawparens(scalarvoid(o))); PL_curcop = &PL_compiling; PL_main_start = LINKLIST(PL_main_root); + PL_main_root->op_private |= OPpREFCOUNTED; + OpREFCNT_set(PL_main_root, 1); PL_main_root->op_next = 0; peep(PL_main_start); PL_compcv = 0; @@ -1970,7 +2006,7 @@ Perl_newPROG(pTHX_ OP *o) if (cv) { dSP; PUSHMARK(SP); - XPUSHs((SV*)PL_compiling.cop_filegv); + XPUSHs((SV*)CopFILEGV(&PL_compiling)); PUTBACK; call_sv((SV*)cv, G_DISCARD); } @@ -2112,8 +2148,12 @@ Perl_fold_constants(pTHX_ register OP *o) return o; if (!(PL_hints & HINT_INTEGER)) { - if (type == OP_DIVIDE || !(o->op_flags & OPf_KIDS)) + if (type == OP_MODULO + || type == OP_DIVIDE + || !(o->op_flags & OPf_KIDS)) + { return o; + } for (curop = ((UNOP*)o)->op_first; curop; curop = curop->op_sibling) { if (curop->op_type == OP_CONST) { @@ -2775,7 +2815,7 @@ Perl_pmruntime(pTHX_ OP *o, OP *expr, OP *repl) } #else if (curop->op_type == OP_GV) { - GV *gv = ((GVOP*)curop)->op_gv; + GV *gv = (GV*)((SVOP*)curop)->op_sv; repl_has_vars = 1; if (strchr("&`'123456789+", *GvENAME(gv))) break; @@ -2859,18 +2899,7 @@ OP * Perl_newGVOP(pTHX_ I32 type, I32 flags, GV *gv) { dTHR; - GVOP *gvop; - NewOp(1101, gvop, 1, GVOP); - gvop->op_type = type; - gvop->op_ppaddr = PL_ppaddr[type]; - gvop->op_gv = (GV*)SvREFCNT_inc(gv); - gvop->op_next = (OP*)gvop; - gvop->op_flags = flags; - if (PL_opargs[type] & OA_RETSCALAR) - scalar((OP*)gvop); - if (PL_opargs[type] & OA_TARGET) - gvop->op_targ = pad_alloc(type, SVs_PADTMP); - return CHECKOP(type, gvop); + return newSVOP(type, flags, SvREFCNT_inc(gv)); } OP * @@ -3109,7 +3138,7 @@ Perl_newASSIGNOP(pTHX_ I32 flags, OP *left, I32 optype, OP *right) for (curop = LINKLIST(o); curop != o; curop = LINKLIST(curop)) { if (PL_opargs[curop->op_type] & OA_DANGEROUS) { if (curop->op_type == OP_GV) { - GV *gv = ((GVOP*)curop)->op_gv; + GV *gv = (GV*)((SVOP*)curop)->op_sv; if (gv == PL_defgv || SvCUR(gv) == PL_generation) break; SvCUR(gv) = PL_generation; @@ -3161,7 +3190,7 @@ Perl_newASSIGNOP(pTHX_ I32 flags, OP *left, I32 optype, OP *right) { tmpop = ((UNOP*)left)->op_first; if (tmpop->op_type == OP_GV && !pm->op_pmreplroot) { - pm->op_pmreplroot = (OP*)((GVOP*)tmpop)->op_gv; + pm->op_pmreplroot = (OP*)((SVOP*)tmpop)->op_sv; pm->op_pmflags |= PMf_ONCE; tmpop = cUNOPo->op_first; /* to list (nulled) */ tmpop = ((UNOP*)tmpop)->op_first; /* to pushmark */ @@ -3245,14 +3274,14 @@ Perl_newSTATEOP(pTHX_ I32 flags, char *label, OP *o) if (PL_copline == NOLINE) cop->cop_line = PL_curcop->cop_line; else { - cop->cop_line = PL_copline; + cop->cop_line = PL_copline; PL_copline = NOLINE; } - cop->cop_filegv = (GV*)SvREFCNT_inc(PL_curcop->cop_filegv); + CopFILEGV_set(cop, (GV*)SvREFCNT_inc(CopFILEGV(PL_curcop))); cop->cop_stash = PL_curstash; if (PERLDB_LINE && PL_curstash != PL_debstash) { - SV **svp = av_fetch(GvAV(PL_curcop->cop_filegv),(I32)cop->cop_line, FALSE); + SV **svp = av_fetch(CopFILEAV(PL_curcop), (I32)CopLINE(cop), FALSE); if (svp && *svp != &PL_sv_undef && !SvIOK(*svp)) { (void)SvIOK_on(*svp); SvIVX(*svp) = 1; @@ -3842,13 +3871,14 @@ cv_dump(CV *cv) SV** ppad; I32 ix; - PerlIO_printf(Perl_debug_log, "\tCV=0x%lx (%s), OUTSIDE=0x%lx (%s)\n", - cv, + PerlIO_printf(Perl_debug_log, + "\tCV=0x%"UVxf" (%s), OUTSIDE=0x%"UVxf" (%s)\n", + PTR2UV(cv), (CvANON(cv) ? "ANON" : (cv == PL_main_cv) ? "MAIN" : CvUNIQUE(cv) ? "UNIQUE" : CvGV(cv) ? GvNAME(CvGV(cv)) : "UNDEFINED"), - outside, + PTR2UV(outside), (!outside ? "null" : CvANON(outside) ? "ANON" : (outside == PL_main_cv) ? "MAIN" @@ -3865,12 +3895,13 @@ cv_dump(CV *cv) for (ix = 1; ix <= AvFILLp(pad_name); ix++) { if (SvPOK(pname[ix])) - PerlIO_printf(Perl_debug_log, "\t%4d. 0x%lx (%s\"%s\" %ld-%ld)\n", - ix, ppad[ix], + PerlIO_printf(Perl_debug_log, + "\t%4d. 0x%"UVxf" (%s\"%s\" %"IVdf"-%"IVdf")\n", + ix, PTR2UV(ppad[ix]), SvFAKE(pname[ix]) ? "FAKE " : "", SvPVX(pname[ix]), - (long)I_32(SvNVX(pname[ix])), - (long)SvIVX(pname[ix])); + (IV)I_32(SvNVX(pname[ix])), + SvIVX(pname[ix])); } } #endif /* DEBUG_CLOSURES */ @@ -3910,7 +3941,6 @@ S_cv_clone2(pTHX_ CV *proto, CV *outside) MUTEX_INIT(CvMUTEXP(cv)); CvOWNER(cv) = 0; #endif /* USE_THREADS */ - CvFILEGV(cv) = CvFILEGV(proto); CvGV(cv) = (GV*)SvREFCNT_inc(CvGV(proto)); CvSTASH(cv) = CvSTASH(proto); CvROOT(cv) = CvROOT(proto); @@ -4236,7 +4266,6 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block) } } CvGV(cv) = (GV*)SvREFCNT_inc(gv); - CvFILEGV(cv) = PL_curcop->cop_filegv; CvSTASH(cv) = PL_curstash; #ifdef USE_THREADS CvOWNER(cv) = 0; @@ -4314,12 +4343,14 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block) } } - if(CvLVALUE(cv)) { + if (CvLVALUE(cv)) { CvROOT(cv) = newUNOP(OP_LEAVESUBLV, 0, scalarseq(block)); } else { CvROOT(cv) = newUNOP(OP_LEAVESUB, 0, scalarseq(block)); } + CvROOT(cv)->op_private |= OPpREFCOUNTED; + OpREFCNT_set(CvROOT(cv), 1); CvSTART(cv) = LINKLIST(CvROOT(cv)); CvROOT(cv)->op_next = 0; peep(CvSTART(cv)); @@ -4335,8 +4366,8 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block) HV *hv; Perl_sv_setpvf(aTHX_ sv, "%_:%ld-%ld", - GvSV(PL_curcop->cop_filegv), - (long)PL_subline, (long)PL_curcop->cop_line); + CopFILESV(PL_curcop), + (long)PL_subline, (long)CopLINE(PL_curcop)); gv_efullname3(tmpstr, gv, Nullch); hv_store(GvHV(PL_DBsub), SvPVX(tmpstr), SvCUR(tmpstr), sv, 0); hv = GvHVn(db_postponed); @@ -4357,7 +4388,7 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block) if (strEQ(s, "BEGIN")) { I32 oldscope = PL_scopestack_ix; ENTER; - SAVESPTR(PL_compiling.cop_filegv); + SAVESPTR(CopFILEGV(&PL_compiling)); SAVEI16(PL_compiling.cop_line); save_svref(&PL_rs); sv_setsv(PL_rs, PL_nrs); @@ -4469,7 +4500,7 @@ Perl_newXS(pTHX_ char *name, XSUBADDR_t subaddr, char *filename) MUTEX_INIT(CvMUTEXP(cv)); CvOWNER(cv) = 0; #endif /* USE_THREADS */ - CvFILEGV(cv) = gv_fetchfile(filename); + (void)gv_fetchfile(filename); CvXSUB(cv) = subaddr; if (name) { @@ -4533,7 +4564,6 @@ Perl_newFORM(pTHX_ I32 floor, OP *o, OP *block) cv = PL_compcv; GvFORM(gv) = cv; CvGV(cv) = (GV*)SvREFCNT_inc(gv); - CvFILEGV(cv) = PL_curcop->cop_filegv; for (ix = AvFILLp(PL_comppad); ix > 0; ix--) { if (!SvPADMY(PL_curpad[ix]) && !SvIMMORTAL(PL_curpad[ix])) @@ -4541,6 +4571,8 @@ Perl_newFORM(pTHX_ I32 floor, OP *o, OP *block) } CvROOT(cv) = newUNOP(OP_LEAVEWRITE, 0, scalarseq(block)); + CvROOT(cv)->op_private |= OPpREFCOUNTED; + OpREFCNT_set(CvROOT(cv), 1); CvSTART(cv) = LINKLIST(CvROOT(cv)); CvROOT(cv)->op_next = 0; peep(CvSTART(cv)); @@ -5655,11 +5687,11 @@ S_simplify_sort(pTHX_ OP *o) if (kUNOP->op_first->op_type != OP_GV) return; kid = kUNOP->op_first; /* get past rv2sv */ - if (GvSTASH(kGVOP->op_gv) != PL_curstash) + if (GvSTASH((GV*)kSVOP->op_sv) != PL_curstash) return; - if (strEQ(GvNAME(kGVOP->op_gv), "a")) + if (strEQ(GvNAME((GV*)kSVOP->op_sv), "a")) reversed = 0; - else if(strEQ(GvNAME(kGVOP->op_gv), "b")) + else if(strEQ(GvNAME((GV*)kSVOP->op_sv), "b")) reversed = 1; else return; @@ -5670,10 +5702,10 @@ S_simplify_sort(pTHX_ OP *o) if (kUNOP->op_first->op_type != OP_GV) return; kid = kUNOP->op_first; /* get past rv2sv */ - if (GvSTASH(kGVOP->op_gv) != PL_curstash + if (GvSTASH((GV*)kSVOP->op_sv) != PL_curstash || ( reversed - ? strNE(GvNAME(kGVOP->op_gv), "a") - : strNE(GvNAME(kGVOP->op_gv), "b"))) + ? strNE(GvNAME((GV*)kSVOP->op_sv), "a") + : strNE(GvNAME((GV*)kSVOP->op_sv), "b"))) return; o->op_flags &= ~(OPf_STACKED | OPf_SPECIAL); if (reversed) @@ -6072,11 +6104,11 @@ Perl_peep(pTHX_ register OP *o) o->op_type = OP_AELEMFAST; o->op_ppaddr = PL_ppaddr[OP_AELEMFAST]; o->op_private = (U8)i; - GvAVn(((GVOP*)o)->op_gv); + GvAVn((GV*)((SVOP*)o)->op_sv); } } else if ((o->op_private & OPpEARLY_CV) && ckWARN(WARN_UNSAFE)) { - GV *gv = cGVOPo->op_gv; + GV *gv = (GV*)cSVOPo->op_sv; if (SvTYPE(gv) == SVt_PVGV && GvCV(gv) && SvPVX(GvCV(gv))) { /* XXX could check prototype here instead of just carping */ SV *sv = sv_newmortal(); @@ -6187,7 +6219,7 @@ Perl_peep(pTHX_ register OP *o) break; case OP_RETURN: - if (o->op_next->op_type != OP_LEAVESUBLV) { + if (o->op_next && o->op_next->op_type != OP_LEAVESUBLV) { o->op_seq = PL_op_seqmax++; break; }