Happy chainsaw stories; The removal of the 5005 threads

Still imcomplete. Configure will follow

p4raw-id: //depot/perl@18030

1 files changed, 1 insertions, 183 deletions

diff --git a/pp_hot.c b/pp_hot.c
index 8d56ada1b0..29748ffedf 100644
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -21,10 +21,6 @@
 
 /* Hot code. */
 
-#ifdef USE_5005THREADS
-static void unset_cvowner(pTHX_ void *cvarg);
-#endif /* USE_5005THREADS */
-
 PP(pp_const)
 {
     dSP;
@@ -1772,13 +1768,11 @@ 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
@@ -1798,13 +1792,12 @@ PP(pp_iter)
 	if (cx->blk_loop.iterix > cx->blk_loop.itermax)
 	    RETPUSHNO;
 
-#ifndef USE_5005THREADS			  /* don't risk potential race */
+	/* 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
@@ -2557,140 +2550,6 @@ 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)) {
@@ -2722,11 +2581,7 @@ 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) {
@@ -2777,24 +2632,8 @@ 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;
@@ -2811,10 +2650,8 @@ 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;
@@ -3096,22 +2933,3 @@ 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 */