view release on metacpan or  search on metacpan

omnithreads/shared/shared.xs  view on Meta::CPAN

	    if (!SvROK(ref_lock))
	        Perl_croak(aTHX_ "cond_timedwait lock needs to be passed as ref");
	    ref_lock = SvRV(ref_lock);
	    if (SvROK(ref_lock)) ref_lock = SvRV(ref_lock);
	    ssv = Perl_sharedsv_find(aTHX_ ref_lock);
	    if (!ssv)
	        croak("cond_timedwait lock must be a shared value");
	    ul = S_get_userlock(aTHX_ ssv, 1);
	}
	if(ul->lock.owner != aTHX)
	    croak("You need a lock before you can cond_wait");

        PUTBACK;
        {
	    UV token = unlock_interpreter(aTHX);

	    MUTEX_LOCK(&ul->lock.mutex);
	    ul->lock.owner = NULL;
	    locks = ul->lock.locks;
	    ul->lock.locks = 0;
	    /* since we are releasing the lock here we need to tell other
	       people that is ok to go ahead and use it */
	    COND_SIGNAL(&ul->lock.cond);
	    RETVAL = Perl_sharedsv_cond_timedwait(user_condition,
						  &ul->lock.mutex, abs);
	    while (ul->lock.owner != NULL) {
		/* OK -- must reacquire the lock... */
		COND_WAIT(&ul->lock.cond, &ul->lock.mutex);
	    }
	    ul->lock.owner = aTHX;
	    ul->lock.locks = locks;
	    MUTEX_UNLOCK(&ul->lock.mutex);
	    
	    relock_interpreter(aTHX_ token);
	}
        SPAGAIN;

	if (RETVAL == 0)
            XSRETURN_UNDEF;
	OUTPUT:
	RETVAL

void
cond_signal_enabled(SV *ref)
	PROTOTYPE: \[$@%]
	CODE:
	SV *ssv;
	user_lock *ul;

	if(!SvROK(ref))
            Perl_croak(aTHX_ "Argument to cond_signal needs to be passed as ref");
	ref = SvRV(ref);
	if(SvROK(ref))
	    ref = SvRV(ref);
	ssv = Perl_sharedsv_find(aTHX_ ref);
	if(!ssv)
	    croak("cond_signal can only be used on shared values");
	ul = S_get_userlock(aTHX_ ssv, 1);
	if (ckWARN(WARN_THREADS) && ul->lock.owner != aTHX)
	    Perl_warner(aTHX_ packWARN(WARN_THREADS),
			    "cond_signal() called on unlocked variable");
	COND_SIGNAL(&ul->user_cond);

void
cond_broadcast_enabled(SV *ref)
	PROTOTYPE: \[$@%]
	CODE:
	SV *ssv;
	user_lock *ul;

	if(!SvROK(ref))
            Perl_croak(aTHX_ "Argument to cond_broadcast needs to be passed as ref");
	ref = SvRV(ref);
	if(SvROK(ref))
	    ref = SvRV(ref);
	ssv = Perl_sharedsv_find(aTHX_ ref);
	if(!ssv)
	    croak("cond_broadcast can only be used on shared values");
	ul = S_get_userlock(aTHX_ ssv, 1);
	if (ckWARN(WARN_THREADS) && ul->lock.owner != aTHX)
	    Perl_warner(aTHX_ packWARN(WARN_THREADS),
			    "cond_broadcast() called on unlocked variable");
	COND_BROADCAST(&ul->user_cond);


SV*
bless(SV* ref, ...);
	PROTOTYPE: $;$
	CODE:
        {
	  HV* stash;
	  SV *ssv;
	  if (items == 1)
	    stash = CopSTASH(PL_curcop);
	  else {
	    SV* classname = ST(1);
	    STRLEN len;
	    char *ptr;
	    
	    if (classname && !SvGMAGICAL(classname) &&
			!SvAMAGIC(classname) && SvROK(classname))
	      Perl_croak(aTHX_ "Attempt to bless into a reference");
	    ptr = SvPV(classname,len);
	    if (ckWARN(WARN_MISC) && len == 0)
	      Perl_warner(aTHX_ packWARN(WARN_MISC),
			  "Explicit blessing to '' (assuming package main)");
	    stash = gv_stashpvn(ptr, len, TRUE);
	  }
	  SvREFCNT_inc(ref);
	  (void)sv_bless(ref, stash);
	  RETVAL = ref;
	  ssv = Perl_sharedsv_find(aTHX_ ref);
	  if(ssv) {
	    dTHXc;
	    ENTER_LOCK;
	    SHARED_CONTEXT;
	    {
	      SV* fake_stash = newSVpv(HvNAME_get(stash),0);
	      (void)sv_bless(ssv,(HV*)fake_stash);
	    }
	    CALLER_CONTEXT;
	    LEAVE_LOCK;
	  }
	}
    	OUTPUT:
	RETVAL		

BOOT:
{
    int count;

    Perl_sharedsv_init(aTHX);

    ENTER;
    SAVETMPS;
    
    PUSHMARK(SP);
    count = call_pv("CORBA::omniORB::_entry_lock_hooks", G_ARRAY | G_EVAL);
    SPAGAIN;
    if (count == 2) {
	relock_interpreter = DPTR2FPTR(void (*)(pTHX, UV token), POPu);
	unlock_interpreter = DPTR2FPTR(UV (*)(pTHX), POPu);