From 3db8f154c4c6e098a5a0bdf7932e8f86fbd2c451 Mon Sep 17 00:00:00 2001 From: "H.Merijn Brand" Date: Sat, 19 Oct 2002 14:10:21 +0000 Subject: Happy chainsaw stories; The removal of the 5005 threads Still imcomplete. Configure will follow p4raw-id: //depot/perl@18030 --- pp_hot.c | 184 +-------------------------------------------------------------- 1 file changed, 1 insertion(+), 183 deletions(-) (limited to 'pp_hot.c') 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 */ -- cgit v1.2.1