X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=pp.c;h=47e512c51dd414969829c63a68db506e4073e901;hb=e568f1a0c324be00c66a63ff9480ccd16934f37e;hp=7ff513802c3e802370b172637be57d81e54cfb20;hpb=a4af207cede5b404b66a75e2aef9bcb3117451b7;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/pp.c b/pp.c
index 7ff5138..47e512c 100644
--- a/pp.c
+++ b/pp.c
@@ -19,8 +19,6 @@
 
 #include "reentr.h"
 
-/* variations on pp_null */
-
 /* XXX I can't imagine anyone who doesn't have this actually _needs_
    it, since pid_t is an integral type.
    --AD  2/20/1998
@@ -29,6 +27,8 @@
 extern Pid_t getpid (void);
 #endif
 
+/* variations on pp_null */
+
 PP(pp_stub)
 {
     dSP;
@@ -47,8 +47,9 @@ PP(pp_scalar)
 PP(pp_padav)
 {
     dSP; dTARGET;
+    I32 gimme;
     if (PL_op->op_private & OPpLVAL_INTRO)
-	SAVECLEARSV(PL_curpad[PL_op->op_targ]);
+	SAVECLEARSV(PAD_SVl(PL_op->op_targ));
     EXTEND(SP, 1);
     if (PL_op->op_flags & OPf_REF) {
 	PUSHs(TARG);
@@ -59,7 +60,8 @@ PP(pp_padav)
 	PUSHs(TARG);
 	RETURN;
     }
-    if (GIMME == G_ARRAY) {
+    gimme = GIMME_V;
+    if (gimme == G_ARRAY) {
 	I32 maxarg = AvFILL((AV*)TARG) + 1;
 	EXTEND(SP, maxarg);
 	if (SvMAGICAL(TARG)) {
@@ -74,7 +76,7 @@ PP(pp_padav)
 	}
 	SP += maxarg;
     }
-    else {
+    else if (gimme == G_SCALAR) {
 	SV* sv = sv_newmortal();
 	I32 maxarg = AvFILL((AV*)TARG) + 1;
 	sv_setiv(sv, maxarg);
@@ -90,7 +92,7 @@ PP(pp_padhv)
 
     XPUSHs(TARG);
     if (PL_op->op_private & OPpLVAL_INTRO)
-	SAVECLEARSV(PL_curpad[PL_op->op_targ]);
+	SAVECLEARSV(PAD_SVl(PL_op->op_targ));
     if (PL_op->op_flags & OPf_REF)
 	RETURN;
     else if (LVRET) {
@@ -159,7 +161,7 @@ PP(pp_rv2gv)
 		    GV *gv;
 		    if (cUNOP->op_targ) {
 			STRLEN len;
-			SV *namesv = PL_curpad[cUNOP->op_targ];
+			SV *namesv = PAD_SV(cUNOP->op_targ);
 			name = SvPV(namesv, len);
 			gv = (GV*)NEWSV(0,0);
 			gv_init(gv, CopSTASH(PL_curcop), name, len, 0);
@@ -420,7 +422,7 @@ PP(pp_prototype)
 PP(pp_anoncode)
 {
     dSP;
-    CV* cv = (CV*)PL_curpad[PL_op->op_targ];
+    CV* cv = (CV*)PAD_SV(PL_op->op_targ);
     if (CvCLONE(cv))
 	cv = (CV*)sv_2mortal((SV*)cv_clone(cv));
     EXTEND(SP,1);
@@ -764,8 +766,7 @@ PP(pp_undef)
     if (!sv)
 	RETPUSHUNDEF;
 
-    if (SvTHINKFIRST(sv))
-	sv_force_normal(sv);
+    SV_CHECK_THINKFIRST_COW_DROP(sv);
 
     switch (SvTYPE(sv)) {
     case SVt_NULL:
@@ -956,6 +957,8 @@ PP(pp_pow)
                             result *= base;
                             /* Only bother to clear the bit if it is set.  */
                             power &= ~bit;
+                           /* Avoid squaring base again if we're done. */
+                           if (power == 0) break;
                         }
                     }
                     SP--;
@@ -3305,12 +3308,12 @@ PP(pp_crypt)
 #   else
     sv_setpv(TARG, PerlProc_crypt(tmps, SvPV(right, n_a)));
 #   endif
+    SETs(TARG);
+    RETURN;
 #else
     DIE(aTHX_
       "The crypt() function is unimplemented due to excessive paranoia.");
 #endif
-    SETs(TARG);
-    RETURN;
 }
 
 PP(pp_ucfirst)
@@ -3681,11 +3684,10 @@ PP(pp_each)
     HV *hash = (HV*)POPs;
     HE *entry;
     I32 gimme = GIMME_V;
-    I32 realhv = (SvTYPE(hash) == SVt_PVHV);
 
     PUTBACK;
     /* might clobber stack_sp */
-    entry = realhv ? hv_iternext(hash) : avhv_iternext((AV*)hash);
+    entry = hv_iternext(hash);
     SPAGAIN;
 
     EXTEND(SP, 2);
@@ -3696,8 +3698,7 @@ PP(pp_each)
 	    SV *val;
 	    PUTBACK;
 	    /* might clobber stack_sp */
-	    val = realhv ?
-		  hv_iterval(hash, entry) : avhv_iterval((AV*)hash, entry);
+	    val = hv_iterval(hash, entry);
 	    SPAGAIN;
 	    PUSHs(val);
 	}
@@ -3737,19 +3738,13 @@ PP(pp_delete)
 		*MARK = sv ? sv : &PL_sv_undef;
 	    }
 	}
-	else if (hvtype == SVt_PVAV) {
-	    if (PL_op->op_flags & OPf_SPECIAL) {	/* array element */
-		while (++MARK <= SP) {
-		    sv = av_delete((AV*)hv, SvIV(*MARK), discard);
-		    *MARK = sv ? sv : &PL_sv_undef;
-		}
-	    }
-	    else {					/* pseudo-hash element */
-		while (++MARK <= SP) {
-		    sv = avhv_delete_ent((AV*)hv, *MARK, discard, 0);
-		    *MARK = sv ? sv : &PL_sv_undef;
-		}
-	    }
+	else if (hvtype == SVt_PVAV) {                  /* array element */
+            if (PL_op->op_flags & OPf_SPECIAL) {
+                while (++MARK <= SP) {
+                    sv = av_delete((AV*)hv, SvIV(*MARK), discard);
+                    *MARK = sv ? sv : &PL_sv_undef;
+                }
+            }
 	}
 	else
 	    DIE(aTHX_ "Not a HASH reference");
@@ -3770,7 +3765,7 @@ PP(pp_delete)
 	    if (PL_op->op_flags & OPf_SPECIAL)
 		sv = av_delete((AV*)hv, SvIV(keysv), discard);
 	    else
-		sv = avhv_delete_ent((AV*)hv, keysv, discard, 0);
+		DIE(aTHX_ "panic: avhv_delete no longer supported");
 	}
 	else
 	    DIE(aTHX_ "Not a HASH reference");
@@ -3810,8 +3805,6 @@ PP(pp_exists)
 	    if (av_exists((AV*)hv, SvIV(tmpsv)))
 		RETPUSHYES;
 	}
-	else if (avhv_exists_ent((AV*)hv, tmpsv, 0))	/* pseudo-hash element */
-	    RETPUSHYES;
     }
     else {
 	DIE(aTHX_ "Not a HASH reference");
@@ -3824,42 +3817,53 @@ PP(pp_hslice)
     dSP; dMARK; dORIGMARK;
     register HV *hv = (HV*)POPs;
     register I32 lval = (PL_op->op_flags & OPf_MOD || LVRET);
-    I32 realhv = (SvTYPE(hv) == SVt_PVHV);
+    bool localizing = PL_op->op_private & OPpLVAL_INTRO ? TRUE : FALSE;
+    bool other_magic = FALSE;
+
+    if (localizing) {
+        MAGIC *mg;
+        HV *stash;
+
+        other_magic = mg_find((SV*)hv, PERL_MAGIC_env) ||
+            ((mg = mg_find((SV*)hv, PERL_MAGIC_tied))
+             /* Try to preserve the existenceness of a tied hash
+              * element by using EXISTS and DELETE if possible.
+              * Fallback to FETCH and STORE otherwise */
+             && (stash = SvSTASH(SvRV(SvTIED_obj((SV*)hv, mg))))
+             && gv_fetchmethod_autoload(stash, "EXISTS", TRUE)
+             && gv_fetchmethod_autoload(stash, "DELETE", TRUE));
+    }
+
+    while (++MARK <= SP) {
+        SV *keysv = *MARK;
+        SV **svp;
+        HE *he;
+        bool preeminent = FALSE;
+
+        if (localizing) {
+            preeminent = SvRMAGICAL(hv) && !other_magic ? 1 :
+                hv_exists_ent(hv, keysv, 0);
+        }
 
-    if (!realhv && PL_op->op_private & OPpLVAL_INTRO)
-	DIE(aTHX_ "Can't localize pseudo-hash element");
+        he = hv_fetch_ent(hv, keysv, lval, 0);
+        svp = he ? &HeVAL(he) : 0;
 
-    if (realhv || SvTYPE(hv) == SVt_PVAV) {
-	while (++MARK <= SP) {
-	    SV *keysv = *MARK;
-	    SV **svp;
-	    I32 preeminent = SvRMAGICAL(hv) ? 1 :
-				realhv ? hv_exists_ent(hv, keysv, 0)
-				       : avhv_exists_ent((AV*)hv, keysv, 0);
-	    if (realhv) {
-		HE *he = hv_fetch_ent(hv, keysv, lval, 0);
-		svp = he ? &HeVAL(he) : 0;
-	    }
-	    else {
-		svp = avhv_fetch_ent((AV*)hv, keysv, lval, 0);
-	    }
-	    if (lval) {
-		if (!svp || *svp == &PL_sv_undef) {
-		    STRLEN n_a;
-		    DIE(aTHX_ PL_no_helem, SvPV(keysv, n_a));
-		}
-		if (PL_op->op_private & OPpLVAL_INTRO) {
-		    if (preeminent)
-		        save_helem(hv, keysv, svp);
-		    else {
-			STRLEN keylen;
-			char *key = SvPV(keysv, keylen);
-			SAVEDELETE(hv, savepvn(key,keylen), keylen);
-		    }
+        if (lval) {
+            if (!svp || *svp == &PL_sv_undef) {
+                STRLEN n_a;
+                DIE(aTHX_ PL_no_helem, SvPV(keysv, n_a));
+            }
+            if (localizing) {
+                if (preeminent)
+                    save_helem(hv, keysv, svp);
+                else {
+                    STRLEN keylen;
+                    char *key = SvPV(keysv, keylen);
+                    SAVEDELETE(hv, savepvn(key,keylen), keylen);
                 }
-	    }
-	    *MARK = svp ? *svp : &PL_sv_undef;
-	}
+            }
+        }
+        *MARK = svp ? *svp : &PL_sv_undef;
     }
     if (GIMME != G_ARRAY) {
 	MARK = ORIGMARK;
@@ -4370,17 +4374,13 @@ PP(pp_split)
 
     if (pm->op_pmreplroot) {
 #ifdef USE_ITHREADS
-	ary = GvAVn((GV*)PL_curpad[INT2PTR(PADOFFSET, pm->op_pmreplroot)]);
+	ary = GvAVn((GV*)PAD_SVl(INT2PTR(PADOFFSET, pm->op_pmreplroot)));
 #else
 	ary = GvAVn((GV*)pm->op_pmreplroot);
 #endif
     }
     else if (gimme != G_ARRAY)
-#ifdef USE_5005THREADS
-	ary = (AV*)PL_curpad[0];
-#else
 	ary = GvAVn(PL_defgv);
-#endif /* USE_5005THREADS */
     else
 	ary = Nullav;
     if (ary && (gimme != G_ARRAY || (pm->op_pmflags & PMf_ONCE))) {
@@ -4588,8 +4588,12 @@ PP(pp_split)
 	iters++;
     }
     else if (!origlimit) {
-	while (iters > 0 && (!TOPs || !SvANY(TOPs) || SvCUR(TOPs) == 0))
-	    iters--, SP--;
+	while (iters > 0 && (!TOPs || !SvANY(TOPs) || SvCUR(TOPs) == 0)) {
+	    if (TOPs && !make_mortal)
+		sv_2mortal(TOPs);
+	    iters--;
+	    SP--;
+	}
     }
 
     if (realarray) {
@@ -4636,25 +4640,6 @@ PP(pp_split)
     RETPUSHUNDEF;
 }
 
-#ifdef USE_5005THREADS
-void
-Perl_unlock_condpair(pTHX_ void *svv)
-{
-    MAGIC *mg = mg_find((SV*)svv, PERL_MAGIC_mutex);
-
-    if (!mg)
-	Perl_croak(aTHX_ "panic: unlock_condpair unlocking non-mutex");
-    MUTEX_LOCK(MgMUTEXP(mg));
-    if (MgOWNER(mg) != thr)
-	Perl_croak(aTHX_ "panic: unlock_condpair unlocking mutex that we don't own");
-    MgOWNER(mg) = 0;
-    COND_SIGNAL(MgOWNERCONDP(mg));
-    DEBUG_S(PerlIO_printf(Perl_debug_log, "0x%"UVxf": unlock 0x%"UVxf"\n",
-			  PTR2UV(thr), PTR2UV(svv)));
-    MUTEX_UNLOCK(MgMUTEXP(mg));
-}
-#endif /* USE_5005THREADS */
-
 PP(pp_lock)
 {
     dSP;
@@ -4671,15 +4656,5 @@ PP(pp_lock)
 
 PP(pp_threadsv)
 {
-#ifdef USE_5005THREADS
-    dSP;
-    EXTEND(SP, 1);
-    if (PL_op->op_private & OPpLVAL_INTRO)
-	PUSHs(*save_threadsv(PL_op->op_targ));
-    else
-	PUSHs(THREADSV(PL_op->op_targ));
-    RETURN;
-#else
     DIE(aTHX_ "tried to access per-thread data in non-threaded perl");
-#endif /* USE_5005THREADS */
 }