X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=op.c;h=e69630a0d725579d89d4bb802463c8481d13728c;hb=a7a8d5a96651e3a5e04e9f892f1bb74538631522;hp=7824c228dbf6753d0a9d5a4620c375e6874d8f4a;hpb=7766f1371a6d2b58d0f46fbe6a60785860a39c1e;p=p5sagit%2Fp5-mst-13.2.git diff --git a/op.c b/op.c index 7824c22..e69630a 100644 --- a/op.c +++ b/op.c @@ -23,10 +23,17 @@ /* #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) ((o)->op_targ--) +#ifdef USE_ITHREADS +# define OP_REFCNT_LOCK NOOP +# define OP_REFCNT_UNLOCK NOOP +# define OpREFCNT_set(o,n) ((o)->op_targ = (n)) +# define OpREFCNT_dec(o) (--(o)->op_targ) +#else +# define OP_REFCNT_LOCK NOOP +# define OP_REFCNT_UNLOCK NOOP +# define OpREFCNT_set(o,n) NOOP +# define OpREFCNT_dec(o) 0 +#endif #ifdef PL_OP_SLAB_ALLOC #define SLAB_SIZE 8192 @@ -660,7 +667,6 @@ Perl_op_free(pTHX_ OP *o) OP_REFCNT_UNLOCK; return; } - o->op_targ = 0; /* XXXXXX */ OP_REFCNT_UNLOCK; break; default: @@ -722,7 +728,7 @@ S_op_clear(pTHX_ OP *o) #ifdef USE_ITHREADS if (cPADOPo->op_padix > 0) { if (PL_curpad) { - GV *gv = cGVOPo; + GV *gv = cGVOPo_gv; pad_swipe(cPADOPo->op_padix); /* No GvIN_PAD_off(gv) here, because other references may still * exist on the pad */ @@ -1403,7 +1409,7 @@ Perl_mod(pTHX_ OP *o, I32 type) break; } - cv = GvCV(kGVOP); + cv = GvCV(kGVOP_gv); if (!cv) goto restore_2cv; if (CvLVALUE(cv)) @@ -2861,7 +2867,7 @@ Perl_pmruntime(pTHX_ OP *o, OP *expr, OP *repl) } #else if (curop->op_type == OP_GV) { - GV *gv = cGVOPx(curop); + GV *gv = cGVOPx_gv(curop); repl_has_vars = 1; if (strchr("&`'123456789+", *GvENAME(gv))) break; @@ -3209,7 +3215,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 = cGVOPx(curop); + GV *gv = cGVOPx_gv(curop); if (gv == PL_defgv || SvCUR(gv) == PL_generation) break; SvCUR(gv) = PL_generation; @@ -3365,7 +3371,7 @@ Perl_newSTATEOP(pTHX_ I32 flags, char *label, OP *o) 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) = (IV)cop; + SvIVX(*svp) = PTR2IV(cop); } } @@ -5114,7 +5120,7 @@ Perl_ck_rvconst(pTHX_ register OP *o) kid->op_type = OP_GV; SvREFCNT_dec(kid->op_sv); #ifdef USE_ITHREADS - /* XXXXXX hack: dependence on sizeof(PADOP) <= sizeof(SVOP) */ + /* XXX hack: dependence on sizeof(PADOP) <= sizeof(SVOP) */ kPADOP->op_padix = pad_alloc(OP_GV, SVs_PADTMP); GvIN_PAD_on(gv); PL_curpad[kPADOP->op_padix] = SvREFCNT_inc(gv); @@ -5286,26 +5292,46 @@ Perl_ck_fun(pTHX_ OP *o) else { I32 flags = OPf_SPECIAL; I32 priv = 0; + PADOFFSET targ = 0; + /* is this op a FH constructor? */ if (is_handle_constructor(o,numargs)) { - flags = 0; - /* Set a flag to tell rv2gv to vivify + char *name = Nullch; + STRLEN len; + + flags = 0; + /* Set a flag to tell rv2gv to vivify * need to "prove" flag does not mean something * else already - NI-S 1999/05/07 - */ - priv = OPpDEREF; -#if 0 - /* Helps with open($array[$n],...) - but is too simplistic - need to do selectively - */ - mod(kid,type); -#endif + */ + priv = OPpDEREF; + if (kid->op_type == OP_PADSV) { + SV **namep = av_fetch(PL_comppad_name, + kid->op_targ, 4); + if (namep && *namep) + name = SvPV(*namep, len); + } + else if (kid->op_type == OP_RV2SV + && kUNOP->op_first->op_type == OP_GV) + { + GV *gv = cGVOPx_gv(kUNOP->op_first); + name = GvNAME(gv); + len = GvNAMELEN(gv); + } + if (name) { + SV *namesv; + targ = pad_alloc(OP_RV2GV, SVs_PADTMP); + namesv = PL_curpad[targ]; + SvUPGRADE(namesv, SVt_PV); + if (*name != '$') + sv_setpvn(namesv, "$", 1); + sv_catpvn(namesv, name, len); + } } kid->op_sibling = 0; kid = newUNOP(OP_RV2GV, flags, scalar(kid)); - if (priv) { - kid->op_private |= priv; - } + kid->op_targ = targ; + kid->op_private |= priv; } kid->op_sibling = sibl; *tokid = kid; @@ -5350,18 +5376,18 @@ Perl_ck_glob(pTHX_ OP *o) if (!((gv = gv_fetchpv("glob", FALSE, SVt_PVCV)) && GvIMPORTED_CV(gv))) gv = gv_fetchpv("CORE::GLOBAL::glob", FALSE, SVt_PVCV); -#if defined(PERL_INTERNAL_GLOB) && !defined(MINIPERL_BUILD) +#if !defined(PERL_EXTERNAL_GLOB) /* XXX this can be tightened up and made more failsafe. */ if (!gv) { OP *modname = newSVOP(OP_CONST, 0, newSVpvn("File::Glob", 10)); modname->op_private |= OPpCONST_BARE; ENTER; utilize(1, start_subparse(FALSE, 0), Nullop, modname, - newSVOP(OP_CONST, 0, newSVpvn("globally", 8))); + newSVOP(OP_CONST, 0, newSVpvn(":globally", 9))); gv = gv_fetchpv("CORE::GLOBAL::glob", FALSE, SVt_PVCV); LEAVE; } -#endif /* PERL_INTERNAL_GLOB && !MINIPERL_BUILD */ +#endif /* PERL_EXTERNAL_GLOB */ if (gv && GvIMPORTED_CV(gv)) { append_elem(OP_GLOB, o, @@ -5826,7 +5852,7 @@ S_simplify_sort(pTHX_ OP *o) if (kUNOP->op_first->op_type != OP_GV) return; kid = kUNOP->op_first; /* get past rv2sv */ - gv = kGVOP; + gv = kGVOP_gv; if (GvSTASH(gv) != PL_curstash) return; if (strEQ(GvNAME(gv), "a")) @@ -5842,7 +5868,7 @@ S_simplify_sort(pTHX_ OP *o) if (kUNOP->op_first->op_type != OP_GV) return; kid = kUNOP->op_first; /* get past rv2sv */ - gv = kGVOP; + gv = kGVOP_gv; if (GvSTASH(gv) != PL_curstash || ( reversed ? strNE(GvNAME(gv), "a") @@ -5952,7 +5978,7 @@ Perl_ck_subr(pTHX_ OP *o) null(cvop); /* disable rv2cv */ tmpop = (SVOP*)((UNOP*)cvop)->op_first; if (tmpop->op_type == OP_GV && !(o->op_private & OPpENTERSUB_AMPER)) { - GV *gv = cGVOPx(tmpop); + GV *gv = cGVOPx_gv(tmpop); cv = GvCVu(gv); if (!cv) tmpop->op_private |= OPpEARLY_CV; @@ -6020,7 +6046,7 @@ Perl_ck_subr(pTHX_ OP *o) (gvop = ((UNOP*)gvop)->op_first) && gvop->op_type == OP_GV) { - GV *gv = cGVOPx(gvop); + GV *gv = cGVOPx_gv(gvop); OP *sibling = o2->op_sibling; SV *n = newSVpvn("",0); op_free(o2); @@ -6262,12 +6288,12 @@ Perl_peep(pTHX_ register OP *o) o->op_type = OP_AELEMFAST; o->op_ppaddr = PL_ppaddr[OP_AELEMFAST]; o->op_private = (U8)i; - gv = cGVOPo; + gv = cGVOPo_gv; GvAVn(gv); } } else if ((o->op_private & OPpEARLY_CV) && ckWARN(WARN_UNSAFE)) { - GV *gv = cGVOPo; + GV *gv = cGVOPo_gv; if (SvTYPE(gv) == SVt_PVGV && GvCV(gv) && SvPVX(GvCV(gv))) { /* XXX could check prototype here instead of just carping */ SV *sv = sv_newmortal(); @@ -6348,7 +6374,7 @@ Perl_peep(pTHX_ register OP *o) fields = (GV**)hv_fetch(SvSTASH(lexname), "FIELDS", 6, FALSE); if (!fields || !GvHV(*fields)) break; - svp = &cSVOPx_sv(((BINOP*)o)->op_last); + svp = cSVOPx_svp(((BINOP*)o)->op_last); key = SvPV(*svp, keylen); indsvp = hv_fetch(GvHV(*fields), key, keylen, FALSE); if (!indsvp) {