-/* sharedsv.c
+/* shared.xs
*
- * Copyright (c) 2001, Larry Wall
+ * Copyright (c) 2001-2002, Larry Wall
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
#include "perl.h"
#include "XSUB.h"
+#ifdef USE_ITHREADS
+
#define SHAREDSvPTR(a) ((a)->sv)
/*
CALLER_CONTEXT; \
LEAVE_LOCK; \
} STMT_END
-
+
/*
/* Try shared SV as 1st choice */
if (!data && ssv && SvTYPE(ssv) >= SVt_PVMG) {
- if (mg = mg_find(ssv, PERL_MAGIC_ext)) {
+ if( (mg = mg_find(ssv, PERL_MAGIC_ext)) ){
data = (shared_sv *) mg->mg_ptr;
}
}
case SVt_PVCV:
Perl_croak(aTHX_ "Cannot share subs yet");
break;
-
+
default:
ENTER_LOCK;
Perl_sharedsv_associate(aTHX_ &sv, 0, 0);
}
}
else {
+ SvTEMP_off(sv);
SHARED_CONTEXT;
sv_setsv_nomg(SHAREDSvPTR(shared), sv);
CALLER_CONTEXT;
sharedsv_scalar_mg_free(pTHX_ SV *sv, MAGIC *mg)
{
shared_sv *shared = (shared_sv *) mg->mg_ptr;
+#if 0
assert (SvREFCNT(SHAREDSvPTR(shared)) < 1000);
+#endif
Perl_sharedsv_free(aTHX_ shared);
return 0;
}
int
sharedsv_scalar_mg_clear(pTHX_ SV *sv, MAGIC *mg)
{
- shared_sv *shared = (shared_sv *) mg->mg_ptr;
return 0;
}
sharedsv_elem_mg_STORE(pTHX_ SV *sv, MAGIC *mg)
{
dTHXc;
- bool allowed;
shared_sv *shared = SV_to_sharedsv(aTHX_ mg->mg_obj);
shared_sv *target;
SV **svp;
{
dTHXc;
shared_sv *shared = SV_to_sharedsv(aTHX_ mg->mg_obj);
- SV* ssv;
ENTER_LOCK;
sharedsv_elem_mg_FETCH(aTHX_ sv, mg);
if (SvTYPE(SHAREDSvPTR(shared)) == SVt_PVAV) {
recursive_lock_acquire(aTHX_ &ssv->lock, __FILE__, __LINE__);
}
+/* handles calls from lock() builtin via PL_lockhook */
+
void
Perl_sharedsv_locksv(pTHX_ SV *sv)
{
- Perl_sharedsv_lock(aTHX_ Perl_sharedsv_find(aTHX_ sv));
+ shared_sv* shared;
+
+ if(SvROK(sv))
+ sv = SvRV(sv);
+ shared = Perl_sharedsv_find(aTHX_ sv);
+ if(!shared)
+ croak("lock can only be used on shared values");
+ Perl_sharedsv_lock(aTHX_ shared);
}
=head1 Shared SV Functions
PL_sharehook = &Perl_sharedsv_share;
}
+#endif /* USE_ITHREADS */
+
MODULE = threads::shared PACKAGE = threads::shared::tie
PROTOTYPES: DISABLE
+#ifdef USE_ITHREADS
void
PUSH(shared_sv *shared, ...)
PROTOTYPES: ENABLE
void
+_id(SV *ref)
+ PROTOTYPE: \[$@%]
+CODE:
+ shared_sv *shared;
+ ref = SvRV(ref);
+ if(SvROK(ref))
+ ref = SvRV(ref);
+ if( (shared = Perl_sharedsv_find(aTHX_ ref)) ){
+ ST(0) = sv_2mortal(newSViv(PTR2IV(shared)));
+ XSRETURN(1);
+ }
+ XSRETURN_UNDEF;
+
+
+void
_refcnt(SV *ref)
PROTOTYPE: \[$@%]
CODE:
shared_sv *shared;
+ ref = SvRV(ref);
if(SvROK(ref))
ref = SvRV(ref);
- if (shared = Perl_sharedsv_find(aTHX_ ref)) {
+ if( (shared = Perl_sharedsv_find(aTHX_ ref)) ){
if (SHAREDSvPTR(shared)) {
ST(0) = sv_2mortal(newSViv(SvREFCNT(SHAREDSvPTR(shared))));
XSRETURN(1);
}
else {
- Perl_warn(aTHX_ "%_ s=%p has no shared SV",ST(0),shared);
+ Perl_warn(aTHX_ "%" SVf " s=%p has no shared SV",ST(0),shared);
}
}
else {
- Perl_warn(aTHX_ "%_ is not shared",ST(0));
+ Perl_warn(aTHX_ "%" SVf " is not shared",ST(0));
}
XSRETURN_UNDEF;
share(SV *ref)
PROTOTYPE: \[$@%]
CODE:
+ ref = SvRV(ref);
if(SvROK(ref))
ref = SvRV(ref);
- Perl_sharedsv_share(aTHX, ref);
+ Perl_sharedsv_share(aTHX_ ref);
void
lock_enabled(SV *ref)
PROTOTYPE: \[$@%]
CODE:
shared_sv* shared;
+ ref = SvRV(ref);
if(SvROK(ref))
ref = SvRV(ref);
- shared = Perl_sharedsv_find(aTHX, ref);
+ shared = Perl_sharedsv_find(aTHX_ ref);
if(!shared)
croak("lock can only be used on shared values");
Perl_sharedsv_lock(aTHX_ shared);
CODE:
shared_sv* shared;
int locks;
+ ref = SvRV(ref);
if(SvROK(ref))
ref = SvRV(ref);
shared = Perl_sharedsv_find(aTHX_ ref);
/* Stealing the members of the lock object worries me - NI-S */
MUTEX_LOCK(&shared->lock.mutex);
shared->lock.owner = NULL;
- locks = shared->lock.locks = 0;
+ locks = shared->lock.locks;
+ shared->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(&shared->lock.cond);
COND_WAIT(&shared->user_cond, &shared->lock.mutex);
+ while(shared->lock.owner != NULL) {
+ COND_WAIT(&shared->lock.cond,&shared->lock.mutex);
+ }
shared->lock.owner = aTHX;
shared->lock.locks = locks;
MUTEX_UNLOCK(&shared->lock.mutex);
PROTOTYPE: \[$@%]
CODE:
shared_sv* shared;
+ ref = SvRV(ref);
if(SvROK(ref))
ref = SvRV(ref);
shared = Perl_sharedsv_find(aTHX_ ref);
+ if (ckWARN(WARN_THREADS) && shared->lock.owner != aTHX)
+ Perl_warner(aTHX_ packWARN(WARN_THREADS),
+ "cond_signal() called on unlocked variable");
if(!shared)
croak("cond_signal can only be used on shared values");
COND_SIGNAL(&shared->user_cond);
PROTOTYPE: \[$@%]
CODE:
shared_sv* shared;
+ ref = SvRV(ref);
if(SvROK(ref))
ref = SvRV(ref);
shared = Perl_sharedsv_find(aTHX_ ref);
if(!shared)
croak("cond_broadcast can only be used on shared values");
+ if (ckWARN(WARN_THREADS) && shared->lock.owner != aTHX)
+ Perl_warner(aTHX_ packWARN(WARN_THREADS),
+ "cond_broadcast() called on unlocked variable");
COND_BROADCAST(&shared->user_cond);
+#endif /* USE_ITHREADS */
+
BOOT:
{
+#ifdef USE_ITHREADS
Perl_sharedsv_init(aTHX);
+#endif /* USE_ITHREADS */
}
+
+
+