This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Integrate:
[perl5.git] / pp_hot.c
index 0b3d622..d303d9a 100644 (file)
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -1,6 +1,6 @@
 /*    pp_hot.c
  *
- *    Copyright (c) 1991-2002, Larry Wall
+ *    Copyright (c) 1991-2003, Larry Wall
  *
  *    You may distribute under the terms of either the GNU General Public
  *    License or the Artistic License, as specified in the README file.
 
 /* Hot code. */
 
+#ifdef USE_5005THREADS
+static void unset_cvowner(pTHX_ void *cvarg);
+#endif /* USE_5005THREADS */
+
 PP(pp_const)
 {
     dSP;
@@ -136,11 +140,12 @@ PP(pp_concat)
     bool lbyte;
     STRLEN rlen;
     char* rpv = SvPV(right, rlen);     /* mg_get(right) happens here */
-    bool rbyte = !SvUTF8(right);
+    bool rbyte = !SvUTF8(right), rcopied = FALSE;
 
     if (TARG == right && right != left) {
        right = sv_2mortal(newSVpvn(rpv, rlen));
        rpv = SvPV(right, rlen);        /* no point setting UTF8 here */
+       rcopied = TRUE;
     }
 
     if (TARG != left) {
@@ -176,6 +181,8 @@ PP(pp_concat)
        if (lbyte)
            sv_utf8_upgrade_nomg(TARG);
        else {
+           if (!rcopied)
+               right = sv_2mortal(newSVpvn(rpv, rlen));
            sv_utf8_upgrade_nomg(right);
            rpv = SvPV(right, rlen);
        }
@@ -316,42 +323,6 @@ 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);
@@ -682,6 +653,9 @@ PP(pp_rv2av)
            SETs((SV*)av);
            RETURN;
        }
+       else if (PL_op->op_flags & OPf_MOD
+               && PL_op->op_private & OPpLVAL_INTRO)
+           Perl_croak(aTHX_ PL_no_localize_ref);
     }
     else {
        if (SvTYPE(sv) == SVt_PVAV) {
@@ -794,7 +768,7 @@ PP(pp_rv2hv)
        tryAMAGICunDEREF(to_hv);
 
        hv = (HV*)SvRV(sv);
-       if (SvTYPE(hv) != SVt_PVHV)
+       if (SvTYPE(hv) != SVt_PVHV && SvTYPE(hv) != SVt_PVAV)
            DIE(aTHX_ "Not a HASH reference");
        if (PL_op->op_flags & OPf_REF) {
            SETs((SV*)hv);
@@ -806,9 +780,12 @@ PP(pp_rv2hv)
            SETs((SV*)hv);
            RETURN;
        }
+       else if (PL_op->op_flags & OPf_MOD
+               && PL_op->op_private & OPpLVAL_INTRO)
+           Perl_croak(aTHX_ PL_no_localize_ref);
     }
     else {
-       if (SvTYPE(sv) == SVt_PVHV) {
+       if (SvTYPE(sv) == SVt_PVHV || SvTYPE(sv) == SVt_PVAV) {
            hv = (HV*)sv;
            if (PL_op->op_flags & OPf_REF) {
                SETs((SV*)hv);
@@ -890,6 +867,8 @@ 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);
@@ -901,14 +880,57 @@ 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;
-        HE *didstore;
-
-        if (ckWARN(WARN_MISC)) {
+       if (ckWARN(WARN_MISC)) {
            if (relem == firstrelem &&
                SvROK(*relem) &&
                (SvTYPE(SvRV(*relem)) == SVt_PVAV ||
@@ -921,16 +943,26 @@ S_do_oddball(pTHX_ HV *hash, SV **relem, SV **firstrelem)
                Perl_warner(aTHX_ packWARN(WARN_MISC),
                            "Odd number of elements in hash assignment");
        }
-
-        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;
+       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;
     }
 }
 
@@ -982,6 +1014,19 @@ 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;
@@ -1180,7 +1225,7 @@ PP(pp_match)
                 (PL_tainted && (pm->op_pmflags & PMf_RETAINT)));
     TAINT_NOT;
 
-    PL_reg_match_utf8 = DO_UTF8(TARG);
+    RX_MATCH_UTF8_set(rx, DO_UTF8(TARG));
 
     /* PMdf_USED is set after a ?? matches once */
     if (pm->op_pmdynflags & PMdf_USED) {
@@ -1355,7 +1400,7 @@ yup:                                      /* Confirmed by INTUIT */
     if (global) {
        rx->subbeg = truebase;
        rx->startp[0] = s - truebase;
-       if (PL_reg_match_utf8) {
+       if (RX_MATCH_UTF8(rx)) {
            char *t = (char*)utf8_hop((U8*)s, rx->minlen);
            rx->endp[0] = t - truebase;
        }
@@ -1466,6 +1511,8 @@ Perl_do_readline(pTHX)
                report_evil_fh(PL_last_in_gv, io, PL_op->op_type);
        }
        if (gimme == G_SCALAR) {
+           /* undef TARG, and push that undefined value */
+           SV_CHECK_THINKFIRST(TARG);
            (void)SvOK_off(TARG);
            PUSHTARG;
        }
@@ -1527,6 +1574,7 @@ Perl_do_readline(pTHX)
                }
            }
            if (gimme == G_SCALAR) {
+               SV_CHECK_THINKFIRST(TARG);
                (void)SvOK_off(TARG);
                SPAGAIN;
                PUSHTARG;
@@ -1610,11 +1658,7 @@ 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) {
@@ -1640,6 +1684,11 @@ 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;
     }
@@ -1768,11 +1817,13 @@ PP(pp_iter)
            STRLEN maxlen;
            char *max = SvPV((SV*)av, maxlen);
            if (!SvNIOK(cur) && SvCUR(cur) <= maxlen) {
+#ifndef USE_5005THREADS                          /* don't risk potential race */
                if (SvREFCNT(*itersvp) == 1 && !SvMAGICAL(*itersvp)) {
                    /* safe to reuse old SV */
                    sv_setsv(*itersvp, cur);
                }
                else
+#endif
                {
                    /* we need a fresh SV every time so that loop body sees a
                     * completely new SV for closures/references to work as
@@ -1792,12 +1843,13 @@ PP(pp_iter)
        if (cx->blk_loop.iterix > cx->blk_loop.itermax)
            RETPUSHNO;
 
-       /* don't risk potential race */
+#ifndef USE_5005THREADS                          /* don't risk potential race */
        if (SvREFCNT(*itersvp) == 1 && !SvMAGICAL(*itersvp)) {
            /* safe to reuse old SV */
            sv_setiv(*itersvp, cx->blk_loop.iterix++);
        }
        else
+#endif
        {
            /* we need a fresh SV every time so that loop body sees a
             * completely new SV for closures/references to work as they
@@ -1877,6 +1929,7 @@ PP(pp_subst)
     I32 oldsave = PL_savestack_ix;
     STRLEN slen;
     bool doutf8 = FALSE;
+    SV *nsv = Nullsv;
 
     /* known replacement string? */
     dstr = (pm->op_pmflags & PMf_CONST) ? POPs : Nullsv;
@@ -1887,8 +1940,8 @@ PP(pp_subst)
        EXTEND(SP,1);
     }
 
-    if (SvIsCOW(TARG))
-       sv_force_normal_flags(TARG,0);
+    if (SvFAKE(TARG) && SvREADONLY(TARG))
+       sv_force_normal(TARG);
     if (SvREADONLY(TARG)
        || (SvTYPE(TARG) > SVt_PVLV
            && !(SvTYPE(TARG) == SVt_PVGV && SvFAKE(TARG))))
@@ -1904,14 +1957,14 @@ PP(pp_subst)
        rxtainted |= 2;
     TAINT_NOT;
 
-    PL_reg_match_utf8 = DO_UTF8(TARG);
+    RX_MATCH_UTF8_set(rx, DO_UTF8(TARG));
 
   force_it:
     if (!pm || !s)
        DIE(aTHX_ "panic: pp_subst");
 
     strend = s + len;
-    slen = PL_reg_match_utf8 ? utf8_length((U8*)s, (U8*)strend) : len;
+    slen = RX_MATCH_UTF8(rx) ? utf8_length((U8*)s, (U8*)strend) : len;
     maxiters = 2 * slen + 10;  /* We can match twice at each
                                   position, once with zero-length,
                                   second time with non-zero. */
@@ -1952,7 +2005,7 @@ PP(pp_subst)
     if (dstr) {
        /* replacement needing upgrading? */
        if (DO_UTF8(TARG) && !doutf8) {
-            SV *nsv = sv_newmortal();
+            nsv = sv_newmortal();
             SvSetSV(nsv, dstr);
             if (PL_encoding)
                  sv_recode_to_utf8(nsv, PL_encoding);
@@ -1973,7 +2026,8 @@ PP(pp_subst)
     
     /* can do inplace substitution? */
     if (c && (I32)clen <= rx->minlen && (once || !(r_flags & REXEC_COPY_STR))
-       && !(rx->reganch & ROPT_LOOKBEHIND_SEEN)) {
+       && !(rx->reganch & ROPT_LOOKBEHIND_SEEN)
+       && (!doutf8 || SvUTF8(TARG))) {
        if (!CALLREGEXEC(aTHX_ rx, s, strend, orig, 0, TARG, NULL,
                         r_flags | REXEC_CHECKED))
        {
@@ -2108,7 +2162,10 @@ PP(pp_subst)
                strend = s + (strend - m);
            }
            m = rx->startp[0] + orig;
-           sv_catpvn(dstr, s, m-s);
+           if (doutf8 && !SvUTF8(dstr))
+               sv_catpvn_utf8_upgrade(dstr, s, m - s, nsv);
+            else
+               sv_catpvn(dstr, s, m-s);
            s = rx->endp[0] + orig;
            if (clen)
                sv_catpvn(dstr, c, clen);
@@ -2116,17 +2173,14 @@ PP(pp_subst)
                break;
        } while (CALLREGEXEC(aTHX_ rx, s, strend, orig, s == m,
                             TARG, NULL, r_flags));
-       if (doutf8 && !DO_UTF8(dstr)) {
-           SV* nsv = sv_2mortal(newSVpvn(s, strend - s));
-           
-           sv_utf8_upgrade(nsv);
-           sv_catpvn(dstr, SvPVX(nsv), SvCUR(nsv));
-       }
+       if (doutf8 && !DO_UTF8(TARG))
+           sv_catpvn_utf8_upgrade(dstr, s, strend - s, nsv);
        else
            sv_catpvn(dstr, s, strend - s);
 
        (void)SvOOK_off(TARG);
-       Safefree(SvPVX(TARG));
+       if (SvLEN(TARG))
+           Safefree(SvPVX(TARG));
        SvPVX(TARG) = SvPVX(dstr);
        SvCUR_set(TARG, SvCUR(dstr));
        SvLEN_set(TARG, SvLEN(dstr));
@@ -2536,7 +2590,7 @@ try_autoload:
            else {
                sub_name = sv_newmortal();
                gv_efullname3(sub_name, gv, Nullch);
-               DIE(aTHX_ "Undefined subroutine &%s called", SvPVX(sub_name));
+               DIE(aTHX_ "Undefined subroutine &%"SVf" called", sub_name);
            }
        }
        if (!cv)
@@ -2551,6 +2605,140 @@ try_autoload:
            DIE(aTHX_ "No DBsub routine");
     }
 
+#ifdef USE_5005THREADS
+    /*
+     * First we need to check if the sub or method requires locking.
+     * If so, we gain a lock on the CV, the first argument or the
+     * stash (for static methods), as appropriate. This has to be
+     * inline because for FAKE_THREADS, COND_WAIT inlines code to
+     * reschedule by returning a new op.
+     */
+    MUTEX_LOCK(CvMUTEXP(cv));
+    if (CvFLAGS(cv) & CVf_LOCKED) {
+       MAGIC *mg;      
+       if (CvFLAGS(cv) & CVf_METHOD) {
+           if (SP > PL_stack_base + TOPMARK)
+               sv = *(PL_stack_base + TOPMARK + 1);
+           else {
+               AV *av = (AV*)PAD_SVl(0);
+               if (hasargs || !av || AvFILLp(av) < 0
+                   || !(sv = AvARRAY(av)[0]))
+               {
+                   MUTEX_UNLOCK(CvMUTEXP(cv));
+                   DIE(aTHX_ "no argument for locked method call");
+               }
+           }
+           if (SvROK(sv))
+               sv = SvRV(sv);
+           else {              
+               STRLEN len;
+               char *stashname = SvPV(sv, len);
+               sv = (SV*)gv_stashpvn(stashname, len, TRUE);
+           }
+       }
+       else {
+           sv = (SV*)cv;
+       }
+       MUTEX_UNLOCK(CvMUTEXP(cv));
+       mg = condpair_magic(sv);
+       MUTEX_LOCK(MgMUTEXP(mg));
+       if (MgOWNER(mg) == thr)
+           MUTEX_UNLOCK(MgMUTEXP(mg));
+       else {
+           while (MgOWNER(mg))
+               COND_WAIT(MgOWNERCONDP(mg), MgMUTEXP(mg));
+           MgOWNER(mg) = thr;
+           DEBUG_S(PerlIO_printf(Perl_debug_log, "%p: pp_entersub lock %p\n",
+                                 thr, sv));
+           MUTEX_UNLOCK(MgMUTEXP(mg));
+           SAVEDESTRUCTOR_X(Perl_unlock_condpair, sv);
+       }
+       MUTEX_LOCK(CvMUTEXP(cv));
+    }
+    /*
+     * Now we have permission to enter the sub, we must distinguish
+     * four cases. (0) It's an XSUB (in which case we don't care
+     * about ownership); (1) it's ours already (and we're recursing);
+     * (2) it's free (but we may already be using a cached clone);
+     * (3) another thread owns it. Case (1) is easy: we just use it.
+     * Case (2) means we look for a clone--if we have one, use it
+     * otherwise grab ownership of cv. Case (3) means we look for a
+     * clone (for non-XSUBs) and have to create one if we don't
+     * already have one.
+     * Why look for a clone in case (2) when we could just grab
+     * ownership of cv straight away? Well, we could be recursing,
+     * i.e. we originally tried to enter cv while another thread
+     * owned it (hence we used a clone) but it has been freed up
+     * and we're now recursing into it. It may or may not be "better"
+     * to use the clone but at least CvDEPTH can be trusted.
+     */
+    if (CvOWNER(cv) == thr || CvXSUB(cv))
+       MUTEX_UNLOCK(CvMUTEXP(cv));
+    else {
+       /* Case (2) or (3) */
+       SV **svp;
+       
+       /*
+        * XXX Might it be better to release CvMUTEXP(cv) while we
+        * do the hv_fetch? We might find someone has pinched it
+        * when we look again, in which case we would be in case
+        * (3) instead of (2) so we'd have to clone. Would the fact
+        * that we released the mutex more quickly make up for this?
+        */
+       if ((svp = hv_fetch(thr->cvcache, (char *)cv, sizeof(cv), FALSE)))
+       {
+           /* We already have a clone to use */
+           MUTEX_UNLOCK(CvMUTEXP(cv));
+           cv = *(CV**)svp;
+           DEBUG_S(PerlIO_printf(Perl_debug_log,
+                                 "entersub: %p already has clone %p:%s\n",
+                                 thr, cv, SvPEEK((SV*)cv)));
+           CvOWNER(cv) = thr;
+           SvREFCNT_inc(cv);
+           if (CvDEPTH(cv) == 0)
+               SAVEDESTRUCTOR_X(unset_cvowner, (void*) cv);
+       }
+       else {
+           /* (2) => grab ownership of cv. (3) => make clone */
+           if (!CvOWNER(cv)) {
+               CvOWNER(cv) = thr;
+               SvREFCNT_inc(cv);
+               MUTEX_UNLOCK(CvMUTEXP(cv));
+               DEBUG_S(PerlIO_printf(Perl_debug_log,
+                           "entersub: %p grabbing %p:%s in stash %s\n",
+                           thr, cv, SvPEEK((SV*)cv), CvSTASH(cv) ?
+                               HvNAME(CvSTASH(cv)) : "(none)"));
+           }
+           else {
+               /* Make a new clone. */
+               CV *clonecv;
+               SvREFCNT_inc(cv); /* don't let it vanish from under us */
+               MUTEX_UNLOCK(CvMUTEXP(cv));
+               DEBUG_S((PerlIO_printf(Perl_debug_log,
+                                      "entersub: %p cloning %p:%s\n",
+                                      thr, cv, SvPEEK((SV*)cv))));
+               /*
+                * We're creating a new clone so there's no race
+                * between the original MUTEX_UNLOCK and the
+                * SvREFCNT_inc since no one will be trying to undef
+                * it out from underneath us. At least, I don't think
+                * there's a race...
+                */
+               clonecv = cv_clone(cv);
+               SvREFCNT_dec(cv); /* finished with this */
+               hv_store(thr->cvcache, (char*)cv, sizeof(cv), (SV*)clonecv,0);
+               CvOWNER(clonecv) = thr;
+               cv = clonecv;
+               SvREFCNT_inc(cv);
+           }
+           DEBUG_S(if (CvDEPTH(cv) != 0)
+                       PerlIO_printf(Perl_debug_log, "depth %ld != 0\n",
+                                     CvDEPTH(cv)));
+           SAVEDESTRUCTOR_X(unset_cvowner, (void*) cv);
+       }
+    }
+#endif /* USE_5005THREADS */
+
     if (CvXSUB(cv)) {
 #ifdef PERL_XSUB_OLDSTYLE
        if (CvOLDSTYLE(cv)) {
@@ -2582,7 +2770,11 @@ try_autoload:
                 * back. This would allow popping @_ in XSUB, e.g.. XXXX */
                AV* av;
                I32 items;
+#ifdef USE_5005THREADS
+               av = (AV*)PAD_SVl(0);
+#else
                av = GvAV(PL_defgv);
+#endif /* USE_5005THREADS */           
                items = AvFILLp(av) + 1;   /* @_ is not tieable */
 
                if (items) {
@@ -2624,8 +2816,8 @@ try_autoload:
        CvDEPTH(cv)++;
        /* XXX This would be a natural place to set C<PL_compcv = cv> so
         * that eval'' ops within this sub know the correct lexical space.
-        * Owing the speed considerations, we choose to search for the cv
-        * in doeval() instead.
+        * Owing the speed considerations, we choose instead to search for
+        * the cv using find_runcv() when calling doeval().
         */
        if (CvDEPTH(cv) < 2)
            (void)SvREFCNT_inc(cv);
@@ -2633,8 +2825,24 @@ try_autoload:
            PERL_STACK_OVERFLOW_CHECK();
            pad_push(padlist, CvDEPTH(cv), 1);
        }
+#ifdef USE_5005THREADS
+       if (!hasargs) {
+           AV* av = (AV*)PAD_SVl(0);
+
+           items = AvFILLp(av) + 1;
+           if (items) {
+               /* Mark is at the end of the stack. */
+               EXTEND(SP, items);
+               Copy(AvARRAY(av), SP + 1, items, SV*);
+               SP += items;
+               PUTBACK ;               
+           }
+       }
+#endif /* USE_5005THREADS */           
        PAD_SET_CUR(padlist, CvDEPTH(cv));
+#ifndef USE_5005THREADS
        if (hasargs)
+#endif /* USE_5005THREADS */
        {
            AV* av;
            SV** ary;
@@ -2651,8 +2859,10 @@ try_autoload:
                AvREAL_off(av);
                AvREIFY_on(av);
            }
+#ifndef USE_5005THREADS
            cx->blk_sub.savearray = GvAV(PL_defgv);
            GvAV(PL_defgv) = (AV*)SvREFCNT_inc(av);
+#endif /* USE_5005THREADS */
            CX_CURPAD_SAVE(cx->blk_sub);
            cx->blk_sub.argarray = av;
            ++MARK;
@@ -2702,8 +2912,8 @@ Perl_sub_crush_depth(pTHX_ CV *cv)
     else {
        SV* tmpstr = sv_newmortal();
        gv_efullname3(tmpstr, CvGV(cv), Nullch);
-       Perl_warner(aTHX_ packWARN(WARN_RECURSION), "Deep recursion on subroutine \"%s\"",
-               SvPVX(tmpstr));
+       Perl_warner(aTHX_ packWARN(WARN_RECURSION), "Deep recursion on subroutine \"%"SVf"\"",
+               tmpstr);
     }
 }
 
@@ -2719,7 +2929,7 @@ PP(pp_aelem)
     SV *sv;
 
     if (SvROK(elemsv) && !SvGAMAGIC(elemsv) && ckWARN(WARN_MISC))
-       Perl_warner(aTHX_ packWARN(WARN_MISC), "Use of reference \"%s\" as array index", SvPV_nolen(elemsv));
+       Perl_warner(aTHX_ packWARN(WARN_MISC), "Use of reference \"%"SVf"\" as array index", elemsv);
     if (elem > 0)
        elem -= PL_curcop->cop_arybase;
     if (SvTYPE(av) != SVt_PVAV)
@@ -2803,7 +3013,7 @@ PP(pp_method)
 PP(pp_method_named)
 {
     dSP;
-    SV* sv = cSVOP->op_sv;
+    SV* sv = cSVOP_sv;
     U32 hash = SvUVX(sv);
 
     XPUSHs(method_common(sv, &hash));
@@ -2937,3 +3147,22 @@ S_method_common(pTHX_ SV* meth, U32* hashp)
     }
     return isGV(gv) ? (SV*)GvCV(gv) : (SV*)gv;
 }
+
+#ifdef USE_5005THREADS
+static void
+unset_cvowner(pTHX_ void *cvarg)
+{
+    register CV* cv = (CV *) cvarg;
+
+    DEBUG_S((PerlIO_printf(Perl_debug_log, "%p unsetting CvOWNER of %p:%s\n",
+                          thr, cv, SvPEEK((SV*)cv))));
+    MUTEX_LOCK(CvMUTEXP(cv));
+    DEBUG_S(if (CvDEPTH(cv) != 0)
+               PerlIO_printf(Perl_debug_log, "depth %ld != 0\n",
+                             CvDEPTH(cv)));
+    assert(thr == CvOWNER(cv));
+    CvOWNER(cv) = 0;
+    MUTEX_UNLOCK(CvMUTEXP(cv));
+    SvREFCNT_dec(cv);
+}
+#endif /* USE_5005THREADS */