1 files changed, 88 insertions, 14 deletions

diff --git a/pp.c b/pp.c
index 8a31fff881..30a4170fc3 100644
--- a/pp.c
+++ b/pp.c
@@ -396,6 +396,7 @@ SV* sv;
     else if (SvPADTMP(sv))
 	sv = newSVsv(sv);
     else {
+	dTHR;			/* just for SvREFCNT_inc */
 	SvTEMP_off(sv);
 	(void)SvREFCNT_inc(sv);
     }
@@ -1461,6 +1462,7 @@ seed()
 #define   SEED_C3	269
 #define   SEED_C5	26107
 
+    dTHR;
     U32 u;
 #ifdef VMS
 #  include <starlet.h>
@@ -2118,9 +2120,11 @@ PP(pp_each)
     HV *hash = (HV*)POPs;
     HE *entry;
     I32 gimme = GIMME_V;
+    I32 realhv = (SvTYPE(hash) == SVt_PVHV);
     
     PUTBACK;
-    entry = hv_iternext(hash);		/* might clobber stack_sp */
+    /* might clobber stack_sp */
+    entry = realhv ? hv_iternext(hash) : avhv_iternext((AV*)hash);
     SPAGAIN;
 
     EXTEND(SP, 2);
@@ -2128,7 +2132,9 @@ PP(pp_each)
 	PUSHs(hv_iterkeysv(entry));	/* won't clobber stack_sp */
 	if (gimme == G_ARRAY) {
 	    PUTBACK;
-	    sv_setsv(TARG, hv_iterval(hash, entry));  /* might hit stack_sp */
+	    /* might clobber stack_sp */
+	    sv_setsv(TARG, realhv ?
+		     hv_iterval(hash, entry) : avhv_iterval((AV*)hash, entry));
 	    SPAGAIN;
 	    PUSHs(TARG);
 	}
@@ -2159,11 +2165,16 @@ PP(pp_delete)
 
     if (op->op_private & OPpSLICE) {
 	dMARK; dORIGMARK;
+	U32 hvtype;
 	hv = (HV*)POPs;
-	if (SvTYPE(hv) != SVt_PVHV)
-	    DIE("Not a HASH reference");
+	hvtype = SvTYPE(hv);
 	while (++MARK <= SP) {
-	    sv = hv_delete_ent(hv, *MARK, discard, 0);
+	    if (hvtype == SVt_PVHV)
+		sv = hv_delete_ent(hv, *MARK, discard, 0);
+	    else if (hvtype == SVt_PVAV)
+		sv = avhv_delete_ent((AV*)hv, *MARK, discard, 0);
+	    else
+		DIE("Not a HASH reference");
 	    *MARK = sv ? sv : &sv_undef;
 	}
 	if (discard)
@@ -2177,9 +2188,12 @@ PP(pp_delete)
     else {
 	SV *keysv = POPs;
 	hv = (HV*)POPs;
-	if (SvTYPE(hv) != SVt_PVHV)
+	if (SvTYPE(hv) == SVt_PVHV)
+	    sv = hv_delete_ent(hv, keysv, discard, 0);
+	else if (SvTYPE(hv) == SVt_PVAV)
+	    sv = avhv_delete_ent((AV*)hv, keysv, discard, 0);
+	else
 	    DIE("Not a HASH reference");
-	sv = hv_delete_ent(hv, keysv, discard, 0);
 	if (!sv)
 	    sv = &sv_undef;
 	if (!discard)
@@ -2193,12 +2207,15 @@ PP(pp_exists)
     dSP;
     SV *tmpsv = POPs;
     HV *hv = (HV*)POPs;
-    STRLEN len;
-    if (SvTYPE(hv) != SVt_PVHV) {
+    if (SvTYPE(hv) == SVt_PVHV) {
+	if (hv_exists_ent(hv, tmpsv, 0))
+	    RETPUSHYES;
+    } else if (SvTYPE(hv) == SVt_PVAV) {
+	if (avhv_exists_ent((AV*)hv, tmpsv, 0))
+	    RETPUSHYES;
+    } else {
 	DIE("Not a HASH reference");
     }
-    if (hv_exists_ent(hv, tmpsv, 0))
-	RETPUSHYES;
     RETPUSHNO;
 }
 
@@ -2208,12 +2225,18 @@ PP(pp_hslice)
     register HE *he;
     register HV *hv = (HV*)POPs;
     register I32 lval = op->op_flags & OPf_MOD;
+    I32 realhv = (SvTYPE(hv) == SVt_PVHV);
 
-    if (SvTYPE(hv) == SVt_PVHV) {
+    if (realhv || SvTYPE(hv) == SVt_PVAV) {
 	while (++MARK <= SP) {
 	    SV *keysv = *MARK;
-
-	    he = hv_fetch_ent(hv, keysv, lval, 0);
+	    SV **svp;
+	    if (realhv) {
+		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 (!he || HeVAL(he) == &sv_undef)
 		    DIE(no_helem, SvPV(keysv, na));
@@ -3950,7 +3973,11 @@ PP(pp_split)
     if (pm->op_pmreplroot)
 	ary = GvAVn((GV*)pm->op_pmreplroot);
     else if (gimme != G_ARRAY)
+#ifdef USE_THREADS
+	ary = (AV*)curpad[0];
+#else
 	ary = GvAVn(defgv);
+#endif /* USE_THREADS */
     else
 	ary = Nullav;
     if (ary && (gimme != G_ARRAY || (pm->op_pmflags & PMf_ONCE))) {
@@ -4132,3 +4159,50 @@ PP(pp_split)
     RETPUSHUNDEF;
 }
 
+#ifdef USE_THREADS
+void
+unlock_condpair(svv)
+void *svv;
+{
+    dTHR;
+    MAGIC *mg = mg_find((SV*)svv, 'm');
+    
+    if (!mg)
+	croak("panic: unlock_condpair unlocking non-mutex");
+    MUTEX_LOCK(MgMUTEXP(mg));
+    if (MgOWNER(mg) != thr)
+	croak("panic: unlock_condpair unlocking mutex that we don't own");
+    MgOWNER(mg) = 0;
+    COND_SIGNAL(MgOWNERCONDP(mg));
+    DEBUG_L(PerlIO_printf(PerlIO_stderr(), "0x%lx: unlock 0x%lx\n",
+			  (unsigned long)thr, (unsigned long)svv);)
+    MUTEX_UNLOCK(MgMUTEXP(mg));
+}
+#endif /* USE_THREADS */
+
+PP(pp_lock)
+{
+    dSP;
+#ifdef USE_THREADS
+    dTOPss;
+    MAGIC *mg;
+    
+    if (SvROK(sv))
+	sv = SvRV(sv);
+
+    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_L(PerlIO_printf(PerlIO_stderr(), "0x%lx: pp_lock lock 0x%lx\n",
+			      (unsigned long)thr, (unsigned long)sv);)
+	MUTEX_UNLOCK(MgMUTEXP(mg));
+	save_destructor(unlock_condpair, sv);
+    }
+#endif /* USE_THREADS */
+    RETURN;
+}