Symbian/S90 further fixes

[p5sagit/p5-mst-13.2.git] / pp_hot.c

diff --git a/pp_hot.c b/pp_hot.c
index 4f35993..476fd80 100644 (file)
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -1,7 +1,7 @@
 /*    pp_hot.c
  *
  *    Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999,
- *    2000, 2001, 2002, 2003, 2004, 2005, 2006, by Larry Wall and others
+ *    2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007 by Larry Wall and others
  *
  *    You may distribute under the terms of either the GNU General Public
  *    License or the Artistic License, as specified in the README file.
@@ -150,7 +150,7 @@ PP(pp_sassign)
                SV *const value = SvRV(cv);
 
                SvUPGRADE((SV *)gv, SVt_RV);
-               SvROK_on(gv);
+               SvPCS_IMPORTED_on(gv);
                SvRV_set(gv, value);
                SvREFCNT_inc_simple_void(value);
                SETs(right);
@@ -1523,7 +1523,7 @@ yup:                                      /* Confirmed by INTUIT */
            if (DEBUG_C_TEST) {
                PerlIO_printf(Perl_debug_log,
                              "Copy on write: pp_match $& capture, type %d, truebase=%p, t=%p, difference %d\n",
-                             (int) SvTYPE(TARG), truebase, t,
+                             (int) SvTYPE(TARG), (void*)truebase, (void*)t,
                              (int)(t-truebase));
            }
            rx->saved_copy = sv_setsv_cow(rx->saved_copy, TARG);
@@ -1838,7 +1838,7 @@ PP(pp_helem)
            SV* lv;
            SV* key2;
            if (!defer) {
-               DIE(aTHX_ PL_no_helem_sv, keysv);
+               DIE(aTHX_ PL_no_helem_sv, SVfARG(keysv));
            }
            lv = sv_newmortal();
            sv_upgrade(lv, SVt_PVLV);
@@ -2120,7 +2120,8 @@ PP(pp_subst)
        !is_cow &&
 #endif
        (SvREADONLY(TARG)
-       || ( (SvTYPE(TARG) == SVt_PVGV || SvTYPE(TARG) > SVt_PVLV)
+        || ( ((SvTYPE(TARG) == SVt_PVGV && isGV_with_GP(TARG))
+              || SvTYPE(TARG) > SVt_PVLV)
             && !(SvTYPE(TARG) == SVt_PVGV && SvFAKE(TARG)))))
        DIE(aTHX_ PL_no_modify);
     PUTBACK;
@@ -2682,40 +2683,6 @@ PP(pp_leavesublv)
     return cx->blk_sub.retop;
 }
 
-
-STATIC void
-S_get_db_sub(pTHX_ SV **svp, CV *cv)
-{
-    dVAR;
-    SV * const dbsv = GvSVn(PL_DBsub);
-
-    save_item(dbsv);
-    if (!PERLDB_SUB_NN) {
-       GV * const gv = CvGV(cv);
-
-       if ( (CvFLAGS(cv) & (CVf_ANON | CVf_CLONED))
-            || strEQ(GvNAME(gv), "END")
-            || ((GvCV(gv) != cv) && /* Could be imported, and old sub redefined. */
-                !( (SvTYPE(*svp) == SVt_PVGV) && (GvCV((GV*)*svp) == cv) ))) {
-           /* Use GV from the stack as a fallback. */
-           /* GV is potentially non-unique, or contain different CV. */
-           SV * const tmp = newRV((SV*)cv);
-           sv_setsv(dbsv, tmp);
-           SvREFCNT_dec(tmp);
-       }
-       else {
-           gv_efullname3(dbsv, gv, NULL);
-       }
-    }
-    else {
-       const int type = SvTYPE(dbsv);
-       if (type < SVt_PVIV && type != SVt_IV)
-           sv_upgrade(dbsv, SVt_PVIV);
-       (void)SvIOK_on(dbsv);
-       SvIV_set(dbsv, PTR2IV(cv));     /* Do it the quickest way  */
-    }
-}
-
 PP(pp_entersub)
 {
     dVAR; dSP; dPOPss;
@@ -2810,7 +2777,7 @@ try_autoload:
            else {
                sub_name = sv_newmortal();
                gv_efullname3(sub_name, gv, NULL);
-               DIE(aTHX_ "Undefined subroutine &%"SVf" called", (void*)sub_name);
+               DIE(aTHX_ "Undefined subroutine &%"SVf" called", SVfARG(sub_name));
            }
        }
        if (!cv)
@@ -2823,7 +2790,7 @@ try_autoload:
         if (CvASSERTION(cv) && PL_DBassertion)
            sv_setiv(PL_DBassertion, 1);
        
-        get_db_sub(&sv, cv);
+        Perl_get_db_sub(aTHX_ &sv, cv);
         if (CvISXSUB(cv))
             PL_curcopdb = PL_curcop;
         cv = GvCV(PL_DBsub);
@@ -2898,7 +2865,7 @@ try_autoload:
            sub_crush_depth(cv);
 #if 0
        DEBUG_S(PerlIO_printf(Perl_debug_log,
-                             "%p entersub returning %p\n", thr, CvSTART(cv)));
+                             "%p entersub returning %p\n", (void*)thr, (void*)CvSTART(cv)));
 #endif
        RETURNOP(CvSTART(cv));
     }
@@ -2954,7 +2921,7 @@ Perl_sub_crush_depth(pTHX_ CV *cv)
        SV* const tmpstr = sv_newmortal();
        gv_efullname3(tmpstr, CvGV(cv), NULL);
        Perl_warner(aTHX_ packWARN(WARN_RECURSION), "Deep recursion on subroutine \"%"SVf"\"",
-                   (void*)tmpstr);
+                   SVfARG(tmpstr));
     }
 }
 
@@ -2972,7 +2939,7 @@ PP(pp_aelem)
     if (SvROK(elemsv) && !SvGAMAGIC(elemsv) && ckWARN(WARN_MISC))
        Perl_warner(aTHX_ packWARN(WARN_MISC),
                    "Use of reference \"%"SVf"\" as array index",
-                   (void*)elemsv);
+                   SVfARG(elemsv));
     if (elem > 0)
        elem -= CopARYBASE_get(PL_curcop);
     if (SvTYPE(av) != SVt_PVAV)