view release on metacpan or  search on metacpan

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

{
    user_lock *ul = (user_lock *) mg->mg_ptr;
    assert(aTHX == PL_sharedsv_space);
    if (ul) {
	recursive_lock_destroy(aTHX_ &ul->lock);
	COND_DESTROY(&ul->user_cond);
	PerlMemShared_free(ul);
	mg->mg_ptr = NULL;
    }
    return 0;
}

MGVTBL sharedsv_uesrlock_vtbl = {
 0,				/* get */
 0,				/* set */
 0,				/* len */
 0,				/* clear */
 sharedsv_userlock_free,	/* free */
 0,				/* copy */
 0,				/* dup */
#ifdef MGf_LOCAL
 0				/* local */
#endif
};

/* Access to shared things is heavily based on MAGIC - in mg.h/mg.c/sv.c sense */

/* In any thread that has access to a shared thing there is a "proxy"
   for it in its own space which has 'MAGIC' associated which accesses
   the shared thing.
 */

MGVTBL sharedsv_scalar_vtbl;    /* scalars have this vtable */
MGVTBL sharedsv_array_vtbl;     /* hashes and arrays have this - like 'tie' */
MGVTBL sharedsv_elem_vtbl;      /* elements of hashes and arrays have this
				   _AS WELL AS_ the scalar magic:
   The sharedsv_elem_vtbl associates the element with the array/hash and
   the sharedsv_scalar_vtbl associates it with the value
 */


/* get shared aggregate SV pointed to by threads::shared::tie magic object */

STATIC SV *
S_sharedsv_from_obj(pTHX_ SV *sv)
{
     return SvROK(sv) ? INT2PTR(SV *, SvIV(SvRV(sv))) : NULL;
}


/* Return the user_lock structure (if any) associated with a shared SV.
 * If create is true, create one if it doesn't exist */

STATIC user_lock *
S_get_userlock(pTHX_ SV* ssv, bool create)
{
    MAGIC *mg;
    user_lock *ul = NULL;

    assert(ssv);
    /* XXX redsign the storage of user locks so we dont need a global
     * lock to access them ???? DAPM */
    ENTER_LOCK;
    mg = mg_find(ssv, PERL_MAGIC_ext);
    if (mg)
	ul = (user_lock*)(mg->mg_ptr);
    else if (create) {
	dTHXc;
	SHARED_CONTEXT;
	ul = (user_lock *) PerlMemShared_malloc(sizeof(user_lock));
	Zero(ul, 1, user_lock);
	/* attach to shared SV using ext magic */
	sv_magicext(ssv, NULL, PERL_MAGIC_ext, &sharedsv_uesrlock_vtbl,
	       (char *)ul, 0);
	recursive_lock_init(aTHX_ &ul->lock);
	COND_INIT(&ul->user_cond);
	CALLER_CONTEXT;
    }
    LEAVE_LOCK;
    return ul;
}


=for apidoc sharedsv_find

Given a private side SV tries to find if the SV has a shared backend,
by looking for the magic.

=cut

SV *
Perl_sharedsv_find(pTHX_ SV *sv)
{
    MAGIC *mg;
    if (SvTYPE(sv) >= SVt_PVMG) {
	switch(SvTYPE(sv)) {
	case SVt_PVAV:
	case SVt_PVHV:
	    if ((mg = mg_find(sv, PERL_MAGIC_tied))
		&& mg->mg_virtual == &sharedsv_array_vtbl) {
		return (SV *) mg->mg_ptr;
	    }
	    break;
	default:
	    /* This should work for elements as well as they
	     * have scalar magic as well as their element magic
	     */
	    if ((mg = mg_find(sv, PERL_MAGIC_shared_scalar))
		&& mg->mg_virtual == &sharedsv_scalar_vtbl) {
		return (SV *) mg->mg_ptr;
	    }
	    break;
	}
    }
    /* Just for tidyness of API also handle tie objects */
    if (SvROK(sv) && sv_derived_from(sv, "omnithreads::shared::tie")) {
	return S_sharedsv_from_obj(aTHX_ sv);
    }
    return NULL;
}