X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=pp_hot.c;h=f0d3e98845601e6827439a62197db3ea67207c8f;hb=2b5e58c4e3614e505a895c6ac7f709db82f8f7f4;hp=ae1b1c209e371db78bbfad40427f4ba272157208;hpb=4a176938c74b8176b4a677d188d6588d5e88332e;p=p5sagit%2Fp5-mst-13.2.git diff --git a/pp_hot.c b/pp_hot.c index ae1b1c2..f0d3e98 100644 --- a/pp_hot.c +++ b/pp_hot.c @@ -320,6 +320,42 @@ PP(pp_or) } } +PP(pp_dor) +{ + /* Most of this is lifted straight from pp_defined */ + dSP; + register SV* sv; + + sv = TOPs; + if (!sv || !SvANY(sv)) { + --SP; + RETURNOP(cLOGOP->op_other); + } + + switch (SvTYPE(sv)) { + case SVt_PVAV: + if (AvMAX(sv) >= 0 || SvGMAGICAL(sv) || (SvRMAGICAL(sv) && mg_find(sv, PERL_MAGIC_tied))) + RETURN; + break; + case SVt_PVHV: + if (HvARRAY(sv) || SvGMAGICAL(sv) || (SvRMAGICAL(sv) && mg_find(sv, PERL_MAGIC_tied))) + RETURN; + break; + case SVt_PVCV: + if (CvROOT(sv) || CvXSUB(sv)) + RETURN; + break; + default: + if (SvGMAGICAL(sv)) + mg_get(sv); + if (SvOK(sv)) + RETURN; + } + + --SP; + RETURNOP(cLOGOP->op_other); +} + PP(pp_add) { dSP; dATARGET; bool useleft; tryAMAGICbin(add,opASSIGN); @@ -762,7 +798,7 @@ PP(pp_rv2hv) tryAMAGICunDEREF(to_hv); hv = (HV*)SvRV(sv); - if (SvTYPE(hv) != SVt_PVHV && SvTYPE(hv) != SVt_PVAV) + if (SvTYPE(hv) != SVt_PVHV) DIE(aTHX_ "Not a HASH reference"); if (PL_op->op_flags & OPf_REF) { SETs((SV*)hv); @@ -776,7 +812,7 @@ PP(pp_rv2hv) } } else { - if (SvTYPE(sv) == SVt_PVHV || SvTYPE(sv) == SVt_PVAV) { + if (SvTYPE(sv) == SVt_PVHV) { hv = (HV*)sv; if (PL_op->op_flags & OPf_REF) { SETs((SV*)hv); @@ -858,8 +894,6 @@ PP(pp_rv2hv) } else { dTARGET; - if (SvTYPE(hv) == SVt_PVAV) - hv = avhv_keys((AV*)hv); if (HvFILL(hv)) Perl_sv_setpvf(aTHX_ TARG, "%"IVdf"/%"IVdf, (IV)HvFILL(hv), (IV)HvMAX(hv) + 1); @@ -871,57 +905,14 @@ PP(pp_rv2hv) } } -STATIC int -S_do_maybe_phash(pTHX_ AV *ary, SV **lelem, SV **firstlelem, SV **relem, - SV **lastrelem) -{ - OP *leftop; - I32 i; - - leftop = ((BINOP*)PL_op)->op_last; - assert(leftop); - assert(leftop->op_type == OP_NULL && leftop->op_targ == OP_LIST); - leftop = ((LISTOP*)leftop)->op_first; - assert(leftop); - /* Skip PUSHMARK and each element already assigned to. */ - for (i = lelem - firstlelem; i > 0; i--) { - leftop = leftop->op_sibling; - assert(leftop); - } - if (leftop->op_type != OP_RV2HV) - return 0; - - /* pseudohash */ - if (av_len(ary) > 0) - av_fill(ary, 0); /* clear all but the fields hash */ - if (lastrelem >= relem) { - while (relem < lastrelem) { /* gobble up all the rest */ - SV *tmpstr; - assert(relem[0]); - assert(relem[1]); - /* Avoid a memory leak when avhv_store_ent dies. */ - tmpstr = sv_newmortal(); - sv_setsv(tmpstr,relem[1]); /* value */ - relem[1] = tmpstr; - if (avhv_store_ent(ary,relem[0],tmpstr,0)) - (void)SvREFCNT_inc(tmpstr); - if (SvMAGICAL(ary) != 0 && SvSMAGICAL(tmpstr)) - mg_set(tmpstr); - relem += 2; - TAINT_NOT; - } - } - if (relem == lastrelem) - return 1; - return 2; -} - STATIC void S_do_oddball(pTHX_ HV *hash, SV **relem, SV **firstrelem) { if (*relem) { SV *tmpstr; - if (ckWARN(WARN_MISC)) { + HE *didstore; + + if (ckWARN(WARN_MISC)) { if (relem == firstrelem && SvROK(*relem) && (SvTYPE(SvRV(*relem)) == SVt_PVAV || @@ -934,26 +925,16 @@ S_do_oddball(pTHX_ HV *hash, SV **relem, SV **firstrelem) Perl_warner(aTHX_ packWARN(WARN_MISC), "Odd number of elements in hash assignment"); } - if (SvTYPE(hash) == SVt_PVAV) { - /* pseudohash */ - tmpstr = sv_newmortal(); - if (avhv_store_ent((AV*)hash,*relem,tmpstr,0)) - (void)SvREFCNT_inc(tmpstr); - if (SvMAGICAL(hash) && SvSMAGICAL(tmpstr)) - mg_set(tmpstr); - } - else { - HE *didstore; - tmpstr = NEWSV(29,0); - didstore = hv_store_ent(hash,*relem,tmpstr,0); - if (SvMAGICAL(hash)) { - if (SvSMAGICAL(tmpstr)) - mg_set(tmpstr); - if (!didstore) - sv_2mortal(tmpstr); - } - } - TAINT_NOT; + + tmpstr = NEWSV(29,0); + didstore = hv_store_ent(hash,*relem,tmpstr,0); + if (SvMAGICAL(hash)) { + if (SvSMAGICAL(tmpstr)) + mg_set(tmpstr); + if (!didstore) + sv_2mortal(tmpstr); + } + TAINT_NOT; } } @@ -1005,19 +986,6 @@ PP(pp_aassign) case SVt_PVAV: ary = (AV*)sv; magic = SvMAGICAL(ary) != 0; - if (PL_op->op_private & OPpASSIGN_HASH) { - switch (do_maybe_phash(ary, lelem, firstlelem, relem, - lastrelem)) - { - case 0: - goto normal_array; - case 1: - do_oddball((HV*)ary, relem, firstrelem); - } - relem = lastrelem + 1; - break; - } - normal_array: av_clear(ary); av_extend(ary, lastrelem - relem); i = 0; @@ -1454,8 +1422,11 @@ Perl_do_readline(pTHX) call_method("READLINE", gimme); LEAVE; SPAGAIN; - if (gimme == G_SCALAR) - SvSetMagicSV_nosteal(TARG, TOPs); + if (gimme == G_SCALAR) { + SV* result = POPs; + SvSetSV_nosteal(TARG, result); + PUSHTARG; + } RETURN; } fp = Nullfp; @@ -1513,10 +1484,14 @@ Perl_do_readline(pTHX) tmplen = SvLEN(sv); /* remember if already alloced */ if (!tmplen) Sv_Grow(sv, 80); /* try short-buffering it */ - if (type == OP_RCATLINE) + offset = 0; + if (type == OP_RCATLINE && SvOK(sv)) { + if (!SvPOK(sv)) { + STRLEN n_a; + (void)SvPV_force(sv, n_a); + } offset = SvCUR(sv); - else - offset = 0; + } } else { sv = sv_2mortal(NEWSV(57, 80)); @@ -1639,7 +1614,11 @@ PP(pp_helem) U32 lval = PL_op->op_flags & OPf_MOD || LVRET; U32 defer = PL_op->op_private & OPpLVAL_DEFER; SV *sv; +#ifdef PERL_COPY_ON_WRITE + U32 hash = (SvIsCOW_shared_hash(keysv)) ? SvUVX(keysv) : 0; +#else U32 hash = (SvFAKE(keysv) && SvREADONLY(keysv)) ? SvUVX(keysv) : 0; +#endif I32 preeminent = 0; if (SvTYPE(hv) == SVt_PVHV) { @@ -1665,11 +1644,6 @@ PP(pp_helem) he = hv_fetch_ent(hv, keysv, lval && !defer, hash); svp = he ? &HeVAL(he) : 0; } - else if (SvTYPE(hv) == SVt_PVAV) { - if (PL_op->op_private & OPpLVAL_INTRO) - DIE(aTHX_ "Can't localize pseudo-hash element"); - svp = avhv_fetch_ent((AV*)hv, keysv, lval && !defer, hash); - } else { RETPUSHUNDEF; } @@ -1920,8 +1894,8 @@ PP(pp_subst) EXTEND(SP,1); } - if (SvFAKE(TARG) && SvREADONLY(TARG)) - sv_force_normal(TARG); + if (SvIsCOW(TARG)) + sv_force_normal_flags(TARG,0); if (SvREADONLY(TARG) || (SvTYPE(TARG) > SVt_PVLV && !(SvTYPE(TARG) == SVt_PVGV && SvFAKE(TARG))))