From: Dave Mitchell Date: Fri, 6 Jan 2006 21:13:12 +0000 (+0000) Subject: make ithreads shared vars smaller/quicker by eliminating shared_sv X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=29ecdb6fa31693daf50c1386a8ec5d92fb7b0313;p=p5sagit%2Fp5-mst-13.2.git make ithreads shared vars smaller/quicker by eliminating shared_sv struct. Also document how it works. p4raw-id: //depot/perl@26684 --- diff --git a/ext/threads/shared/shared.xs b/ext/threads/shared/shared.xs index 18a752c..53b9e2d 100644 --- a/ext/threads/shared/shared.xs +++ b/ext/threads/shared/shared.xs @@ -13,6 +13,106 @@ * pulled in the (an)other direction by Nick Ing-Simmons nick@ing-simmons.net */ +/* + * Shared variables are implemented by a scheme similar to tieing. + * Each thread has a proxy SV with attached magic -- "private SVs" -- + * which all point to a single SV in a separate shared interpreter + * (PL_sharedsv_space) -- "shared SVs". + * + * The shared SV holds the variable's true values, and its state is + * copied between the shared and private SVs with the usual + * mg_get()/mg_set() arrangement. + * + * Aggregates (AVs and HVs) are implemented using tie magic, except that + * the vtable used is one defined in this file rather than the standard one. + * This means that where a tie function like is FETCH is normally invoked by + * the tie magic's mg_get() function, we completely bypass the calling of a + * perl-level function, and directly call C-level code to handle it. On + * the other hand. calls to functions like PUSH are done directly by code + * in av.c etc, which we can't bypass. So the best we can do is to provide + * XS versions of these functions. We also have to attach a tie object, + * blessed into the class threads::shared::tie, to keep the method-calling + * code happy. + * + * Access to aggregate elements is done the usual tied way by returning a + * proxy PVLV element with attached element magic. + * + * Pointers to the shared SV are squirrelled away in the mg->mg_ptr field + * of magic (with mg_len == 0), and in the IV2PTR(SvIV(sv)) field of tied + * object SVs. These pointers have to be hidden like this because they + * cross interpreter boundaries, and we don't want sv_clear() and friends + * following them. + * + * The three basic shared types look like the following: + * + * ----------------- + * + * Shared scalar (my $s : shared): + * + * SV = PVMG(0x7ba238) at 0x7387a8 + * FLAGS = (PADMY,GMG,SMG) + * MAGIC = 0x824d88 + * MG_TYPE = PERL_MAGIC_shared_scalar(n) + * MG_PTR = 0x810358 <<<< pointer to the shared SV + * + * ----------------- + * + * Shared aggregate (my @a : shared; my %h : shared): + * + * SV = PVAV(0x7175d0) at 0x738708 + * FLAGS = (PADMY,RMG) + * MAGIC = 0x824e48 + * MG_TYPE = PERL_MAGIC_tied(P) + * MG_OBJ = 0x7136e0 <<<< ref to the tied object + * SV = RV(0x7136f0) at 0x7136e0 + * RV = 0x738640 + * SV = PVMG(0x7ba238) at 0x738640 <<<< the tied object + * FLAGS = (OBJECT,IOK,pIOK) + * IV = 8455000 <<<< pointer to the shared AV + * STASH = 0x80abf0 "threads::shared::tie" + * MG_PTR = 0x810358 "" <<<< another pointer to the shared AV + * ARRAY = 0x0 + * + * ----------------- + * + * Aggregate element (my @a : shared; $a[0]) + * + * SV = PVLV(0x77f628) at 0x713550 + * FLAGS = (GMG,SMG,RMG,pIOK) + * MAGIC = 0x72bd58 + * MG_TYPE = PERL_MAGIC_shared_scalar(n) + * MG_PTR = 0x8103c0 "" <<<< pointer to the shared element + * MAGIC = 0x72bd18 + * MG_TYPE = PERL_MAGIC_tiedelem(p) + * MG_OBJ = 0x7136e0 <<<< ref to the tied object + * SV = RV(0x7136f0) at 0x7136e0 + * RV = 0x738660 + * SV = PVMG(0x7ba278) at 0x738660 <<<< the tied object + * FLAGS = (OBJECT,IOK,pIOK) + * IV = 8455064 <<<< pointer to the shared AV + * STASH = 0x80ac30 "threads::shared::tie" + * TYPE = t + * + * Note that PERL_MAGIC_tiedelem(p) magic doesn't have a pointer to a + * shared SV in mg_ptr; instead this is used to store the hash key, + * if any, like normal tied elements. Note also that element SVs may have + * pointers to both the shared aggregate and the shared element + * + * + * Userland locks: + * + * if a shared variable is used as a perl-level lock or condition + * variable, then PERL_MAGIC_ext magic is attached to the associated + * *shared* SV, whose mg_ptr field points to a malloced structure + * containing the necessary mutexes and condition variables. + * + * Nomenclature: + * + * In this file, any variable name prefixed with 's', eg ssv, stmp or sobj, + * usually represents a shared SV which correspondis to a private SV named + * without the prefix, eg sv, tmp or obj. + */ + #define PERL_NO_GET_CONTEXT #include "EXTERN.h" #include "perl.h" @@ -20,8 +120,6 @@ #ifdef USE_ITHREADS -#define SHAREDSvPTR(a) ((a)->sv) - /* * The shared things need an intepreter to live in ... */ @@ -132,6 +230,7 @@ recursive_lock_acquire(pTHX_ recursive_lock_t *lock,char *file,int line) recursive_lock_acquire(aTHX_ &PL_sharedsv_lock, __FILE__, __LINE__); \ } STMT_END +/* the unlocking is done automatically at scope exit */ #define LEAVE_LOCK LEAVE @@ -148,52 +247,42 @@ recursive_lock_acquire(pTHX_ recursive_lock_t *lock,char *file,int line) } STMT_END -/* - - Shared SV - - Shared SV is a structure for keeping the backend storage - of shared svs. - - Shared-ness really only needs the SV * - the rest is for locks. - (Which suggests further space optimization ... ) - +/* user-level locks: + This structure is attached (using ext magic) to any shared SV that + is used by user-level locking or condition code */ typedef struct { - SV *sv; /* The actual SV - in shared space */ - recursive_lock_t lock; + recursive_lock_t lock; /* for user-levl locks */ perl_cond user_cond; /* For user-level conditions */ -} shared_sv; +} user_lock; -/* The SV in shared-space has a back-pointer to the shared_sv - struct associated with it PERL_MAGIC_ext. +/* magic used for attaching user_lock structs to shared SVs The vtable used has just one entry - when the SV goes away we free the memory for the above. - */ int -sharedsv_shared_mg_free(pTHX_ SV *sv, MAGIC *mg) +sharedsv_userlock_free(pTHX_ SV *sv, MAGIC *mg) { - shared_sv *shared = (shared_sv *) mg->mg_ptr; - assert( aTHX == PL_sharedsv_space ); - if (shared) { - recursive_lock_destroy(aTHX_ &shared->lock); - COND_DESTROY(&shared->user_cond); - PerlMemShared_free(shared); + 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_shared_vtbl = { +MGVTBL sharedsv_uesrlock_vtbl = { 0, /* get */ 0, /* set */ 0, /* len */ 0, /* clear */ - sharedsv_shared_mg_free, /* free */ + sharedsv_userlock_free, /* free */ 0, /* copy */ 0, /* dup */ 0 /* local */ @@ -209,25 +298,54 @@ MGVTBL sharedsv_shared_vtbl = { 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 + _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 */ -/* Accessor to convert threads::shared::tie objects back shared_sv * */ -shared_sv * -SV_to_sharedsv(pTHX_ SV *sv) +/* get shared aggregate SV pointed to by threads::shared::tie magic object */ + +STATIC SV * +S_sharedsv_from_obj(pTHX_ SV *sv) { - shared_sv *shared = 0; - if (SvROK(sv)) - { - shared = INT2PTR(shared_sv *, SvIV(SvRV(sv))); - } - return shared; + 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, @@ -235,7 +353,7 @@ by looking for the magic. =cut -shared_sv * +SV * Perl_sharedsv_find(pTHX_ SV *sv) { MAGIC *mg; @@ -245,7 +363,7 @@ Perl_sharedsv_find(pTHX_ SV *sv) case SVt_PVHV: if ((mg = mg_find(sv, PERL_MAGIC_tied)) && mg->mg_virtual == &sharedsv_array_vtbl) { - return (shared_sv *) mg->mg_ptr; + return (SV *) mg->mg_ptr; } break; default: @@ -254,157 +372,151 @@ Perl_sharedsv_find(pTHX_ SV *sv) */ if ((mg = mg_find(sv, PERL_MAGIC_shared_scalar)) && mg->mg_virtual == &sharedsv_scalar_vtbl) { - return (shared_sv *) mg->mg_ptr; + return (SV *) mg->mg_ptr; } break; } } /* Just for tidyness of API also handle tie objects */ if (SvROK(sv) && sv_derived_from(sv, "threads::shared::tie")) { - return SV_to_sharedsv(aTHX_ sv); + return S_sharedsv_from_obj(aTHX_ sv); } return NULL; } -/* - * Almost all the pain is in this routine. - * - */ -shared_sv * -Perl_sharedsv_associate(pTHX_ SV **psv, SV *ssv, shared_sv *data) +/* associate a private SV with a shared SV by pointing the appropriate + * magics at it. Assumes lock is held */ + +void +Perl_sharedsv_associate(pTHX_ SV *sv, SV *ssv) { dTHXc; MAGIC *mg = 0; - SV *sv = (psv) ? *psv : Nullsv; - /* If we are asked for an private ops we need a thread */ + /* If we are asked for any private ops we need a thread */ assert ( aTHX != PL_sharedsv_space ); /* To avoid need for recursive locks require caller to hold lock */ assert ( PL_sharedsv_lock.owner == aTHX ); - /* First try and get existing global data structure */ + switch(SvTYPE(sv)) { + case SVt_PVAV: + case SVt_PVHV: + if (!(mg = mg_find(sv, PERL_MAGIC_tied)) + || mg->mg_virtual != &sharedsv_array_vtbl + || (SV*) mg->mg_ptr != ssv) + { + SV *obj = newSV(0); + sv_setref_iv(obj, "threads::shared::tie",PTR2IV(ssv)); + if (mg) { + sv_unmagic(sv, PERL_MAGIC_tied); + } + mg = sv_magicext(sv, obj, PERL_MAGIC_tied, &sharedsv_array_vtbl, + (char *) ssv, 0); + mg->mg_flags |= (MGf_COPY|MGf_DUP); + SvREFCNT_inc(ssv); + SvREFCNT_dec(obj); + if (SvOBJECT(ssv)) { + STRLEN len; + char* stash_ptr = SvPV((SV*) SvSTASH(ssv), len); + HV* stash = gv_stashpvn(stash_ptr, len, TRUE); + SvOBJECT_on(sv); + SvSTASH_set(sv, (HV*)SvREFCNT_inc(stash)); + } + } + break; - /* Try shared SV as 1st choice */ - if (!data && ssv && SvTYPE(ssv) >= SVt_PVMG) { - if( (mg = mg_find(ssv, PERL_MAGIC_ext)) ){ - data = (shared_sv *) mg->mg_ptr; + default: + if ((SvTYPE(sv) < SVt_PVMG) + || !(mg = mg_find(sv, PERL_MAGIC_shared_scalar)) + || mg->mg_virtual != &sharedsv_scalar_vtbl + || (SV*) mg->mg_ptr != ssv) + { + if (mg) { + sv_unmagic(sv, PERL_MAGIC_shared_scalar); + } + mg = sv_magicext(sv, Nullsv, PERL_MAGIC_shared_scalar, + &sharedsv_scalar_vtbl, (char *)ssv, 0); + mg->mg_flags |= (MGf_COPY|MGf_DUP|MGf_LOCAL); + SvREFCNT_inc(ssv); + if(SvOBJECT(ssv)) { + STRLEN len; + char* stash_ptr = SvPV((SV*) SvSTASH(ssv), len); + HV* stash = gv_stashpvn(stash_ptr, len, TRUE); + SvOBJECT_on(sv); + SvSTASH_set(sv, (HV*)SvREFCNT_inc(stash)); + } } + break; } + assert ( Perl_sharedsv_find(aTHX_ sv) == ssv ); +} - /* Next see if private SV is associated with something */ - if (!data && sv) { - data = Perl_sharedsv_find(aTHX_ sv); - } - /* If neither of those then create a new one */ - if (!data) { - SHARED_CONTEXT; - if (!ssv) { - ssv = newSV(0); - SvREFCNT(ssv) = 0; - } - data = (shared_sv *) PerlMemShared_malloc(sizeof(shared_sv)); - Zero(data,1,shared_sv); - SHAREDSvPTR(data) = ssv; - /* Tag shared side SV with data pointer */ - sv_magicext(ssv, ssv, PERL_MAGIC_ext, &sharedsv_shared_vtbl, - (char *)data, 0); - recursive_lock_init(aTHX_ &data->lock); - COND_INIT(&data->user_cond); - CALLER_CONTEXT; - } +/* Given a private SV, create and return an associated shared SV. + * Assumes lock is held */ - if (!ssv) - ssv = SHAREDSvPTR(data); - if (!SHAREDSvPTR(data)) - SHAREDSvPTR(data) = ssv; +STATIC SV * +S_sharedsv_new_shared(pTHX_ SV *sv) +{ + dTHXc; + SV *ssv; - /* If we know type upgrade shared side SV */ - if (sv && SvTYPE(ssv) < SvTYPE(sv)) { - SHARED_CONTEXT; - sv_upgrade(ssv, SvTYPE(*psv)); - if (SvTYPE(ssv) == SVt_PVAV) /* #24061 */ - AvREAL_on(ssv); - CALLER_CONTEXT; - } + assert(PL_sharedsv_lock.owner == aTHX); + assert(aTHX != PL_sharedsv_space); - /* Now if requested allocate private SV */ - if (psv && !sv) { - *psv = sv = newSV(0); - } + SHARED_CONTEXT; + ssv = newSV(0); + SvREFCNT(ssv) = 0; /* will be upped to 1 by Perl_sharedsv_associate */ + sv_upgrade(ssv, SvTYPE(sv)); + CALLER_CONTEXT; + Perl_sharedsv_associate(aTHX_ sv, ssv); + return ssv; +} - /* Finally if private SV exists check and add magic */ - if (sv) { - MAGIC *mg = 0; - if (SvTYPE(sv) < SvTYPE(ssv)) { - sv_upgrade(sv, SvTYPE(ssv)); - } - switch(SvTYPE(sv)) { - case SVt_PVAV: - case SVt_PVHV: - if (!(mg = mg_find(sv, PERL_MAGIC_tied)) - || mg->mg_virtual != &sharedsv_array_vtbl - || (shared_sv *) mg->mg_ptr != data) { - SV *obj = newSV(0); - sv_setref_iv(obj, "threads::shared::tie",PTR2IV(data)); - if (mg) { - sv_unmagic(sv, PERL_MAGIC_tied); - } - mg = sv_magicext(sv, obj, PERL_MAGIC_tied, &sharedsv_array_vtbl, - (char *) data, 0); - mg->mg_flags |= (MGf_COPY|MGf_DUP); - SvREFCNT_inc(ssv); - SvREFCNT_dec(obj); - if(SvOBJECT(ssv)) { - STRLEN len; - char* stash_ptr = SvPV((SV*) SvSTASH(ssv), len); - HV* stash = gv_stashpvn(stash_ptr, len, TRUE); - SvOBJECT_on(sv); - SvSTASH_set(sv, (HV*)SvREFCNT_inc(stash)); - } - } - break; - default: - if ((SvTYPE(sv) < SVt_PVMG) - || !(mg = mg_find(sv, PERL_MAGIC_shared_scalar)) - || mg->mg_virtual != &sharedsv_scalar_vtbl - || (shared_sv *) mg->mg_ptr != data) { - if (mg) { - sv_unmagic(sv, PERL_MAGIC_shared_scalar); - } - mg = sv_magicext(sv, Nullsv, PERL_MAGIC_shared_scalar, - &sharedsv_scalar_vtbl, (char *)data, 0); - mg->mg_flags |= (MGf_COPY|MGf_DUP|MGf_LOCAL); - SvREFCNT_inc(ssv); - if(SvOBJECT(ssv)) { - STRLEN len; - char* stash_ptr = SvPV((SV*) SvSTASH(ssv), len); - HV* stash = gv_stashpvn(stash_ptr, len, TRUE); - SvOBJECT_on(sv); - SvSTASH_set(sv, (HV*)SvREFCNT_inc(stash)); - } - } - break; - } - assert ( Perl_sharedsv_find(aTHX_ *psv) == data ); - } - return data; +/* Given a shared SV, create and return an associated private SV. + * Assumes lock is held */ + +STATIC SV * +S_sharedsv_new_private(pTHX_ SV *ssv) +{ + SV *sv; + + assert(PL_sharedsv_lock.owner == aTHX); + assert(aTHX != PL_sharedsv_space); + + sv = newSV(0); + sv_upgrade(sv, SvTYPE(ssv)); + Perl_sharedsv_associate(aTHX_ sv, ssv); + return sv; } -void -Perl_sharedsv_free(pTHX_ shared_sv *shared) + +/* a threadsafe version of SvREFCNT_dec(ssv) */ + +STATIC void +S_sharedsv_dec(pTHX_ SV* ssv) { - if (shared) { + if (!ssv) + return; + ENTER_LOCK; + if (SvREFCNT(ssv) > 1) { + /* no side effects, so can do it lightweight */ + SvREFCNT_dec(ssv); + } + else { dTHXc; - SHARED_EDIT; - SvREFCNT_dec(SHAREDSvPTR(shared)); - SHARED_RELEASE; + SHARED_CONTEXT; + SvREFCNT_dec(ssv); + CALLER_CONTEXT; } + LEAVE_LOCK; } +/* implements Perl-level share() and :shared */ + void Perl_sharedsv_share(pTHX_ SV *sv) { @@ -419,7 +531,7 @@ Perl_sharedsv_share(pTHX_ SV *sv) default: ENTER_LOCK; - Perl_sharedsv_associate(aTHX_ &sv, 0, 0); + (void) S_sharedsv_new_shared(aTHX_ sv); LEAVE_LOCK; SvSETMAGIC(sv); break; @@ -435,6 +547,8 @@ Perl_sharedsv_share(pTHX_ SV *sv) } while (0) #endif /* WIN32 || OS2 */ +/* do OS-specific condition timed wait */ + bool Perl_sharedsv_cond_timedwait(perl_cond *cond, perl_mutex *mut, double abs) { @@ -497,49 +611,55 @@ Perl_sharedsv_cond_timedwait(perl_cond *cond, perl_mutex *mut, double abs) #endif /* NETWARE || FAKE_THREADS || I_MACH_CTHREADS */ } -/* MAGIC (in mg.h sense) hooks */ +/* ------------ PERL_MAGIC_shared_scalar(n) functions -------------- */ + +/* get magic for PERL_MAGIC_shared_scalar(n) */ int sharedsv_scalar_mg_get(pTHX_ SV *sv, MAGIC *mg) { - shared_sv *shared = (shared_sv *) mg->mg_ptr; - assert(shared); + SV *ssv = (SV *) mg->mg_ptr; + assert(ssv); ENTER_LOCK; - if (SHAREDSvPTR(shared)) { - if (SvROK(SHAREDSvPTR(shared))) { - SV *obj = Nullsv; - Perl_sharedsv_associate(aTHX_ &obj, SvRV(SHAREDSvPTR(shared)), NULL); - sv_setsv_nomg(sv, &PL_sv_undef); - SvRV_set(sv, obj); - SvROK_on(sv); - - } - else { - sv_setsv_nomg(sv, SHAREDSvPTR(shared)); - } + if (SvROK(ssv)) { + SV *obj = S_sharedsv_new_private(aTHX_ SvRV(ssv)); + sv_setsv_nomg(sv, &PL_sv_undef); + SvRV_set(sv, obj); + SvROK_on(sv); + } + else { + sv_setsv_nomg(sv, ssv); } LEAVE_LOCK; return 0; } +/* copy the contents of a private SV to a shared SV: + * used by various mg_set()-type functions. + * Assumes lock is held */ + void -sharedsv_scalar_store(pTHX_ SV *sv, shared_sv *shared) +sharedsv_scalar_store(pTHX_ SV *sv, SV *ssv) { dTHXc; bool allowed = TRUE; + + assert(PL_sharedsv_lock.owner == aTHX); if (SvROK(sv)) { - shared_sv* target = Perl_sharedsv_find(aTHX_ SvRV(sv)); - if (target) { - SV *tmp; + SV *obj = SvRV(sv); + SV *sobj = Perl_sharedsv_find(aTHX_ obj); + if (sobj) { SHARED_CONTEXT; - tmp = newRV(SHAREDSvPTR(target)); - sv_setsv_nomg(SHAREDSvPTR(shared), tmp); - SvREFCNT_dec(tmp); - if(SvOBJECT(SvRV(sv))) { - SV* fake_stash = newSVpv(HvNAME_get(SvSTASH(SvRV(sv))),0); - SvOBJECT_on(SHAREDSvPTR(target)); - SvSTASH_set(SHAREDSvPTR(target), (HV*)fake_stash); + SvUPGRADE(ssv, SVt_RV); + sv_setsv_nomg(ssv, &PL_sv_undef); + + SvRV_set(ssv, SvREFCNT_inc(sobj)); + SvROK_on(ssv); + if(SvOBJECT(obj)) { + SV* fake_stash = newSVpv(HvNAME_get(SvSTASH(obj)),0); + SvOBJECT_on(sobj); + SvSTASH_set(sobj, (HV*)fake_stash); } CALLER_CONTEXT; } @@ -550,11 +670,11 @@ sharedsv_scalar_store(pTHX_ SV *sv, shared_sv *shared) else { SvTEMP_off(sv); SHARED_CONTEXT; - sv_setsv_nomg(SHAREDSvPTR(shared), sv); + sv_setsv_nomg(ssv, sv); if(SvOBJECT(sv)) { SV* fake_stash = newSVpv(HvNAME_get(SvSTASH(sv)),0); - SvOBJECT_on(SHAREDSvPTR(shared)); - SvSTASH_set(SHAREDSvPTR(shared), (HV*)fake_stash); + SvOBJECT_on(ssv); + SvSTASH_set(ssv, (HV*)fake_stash); } CALLER_CONTEXT; } @@ -563,50 +683,44 @@ sharedsv_scalar_store(pTHX_ SV *sv, shared_sv *shared) } } +/* set magic for PERL_MAGIC_shared_scalar(n) */ + int sharedsv_scalar_mg_set(pTHX_ SV *sv, MAGIC *mg) { - shared_sv *shared; + SV *ssv = (SV*)(mg->mg_ptr); + assert(ssv); ENTER_LOCK; - /* We call associate to potentially upgrade shared side SV */ - shared = Perl_sharedsv_associate(aTHX_ &sv, Nullsv, (shared_sv *) mg->mg_ptr); - assert(shared); - sharedsv_scalar_store(aTHX_ sv, shared); + if (SvTYPE(ssv) < SvTYPE(sv)) { + dTHXc; + SHARED_CONTEXT; + sv_upgrade(ssv, SvTYPE(sv)); + CALLER_CONTEXT; + } + sharedsv_scalar_store(aTHX_ sv, ssv); LEAVE_LOCK; return 0; } -int -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; -} +/* free magic for PERL_MAGIC_shared_scalar(n) */ int -sharedsv_scalar_mg_clear(pTHX_ SV *sv, MAGIC *mg) +sharedsv_scalar_mg_free(pTHX_ SV *sv, MAGIC *mg) { + S_sharedsv_dec(aTHX_ (SV*)mg->mg_ptr); return 0; } /* - * Called during cloning of new threads + * Called during cloning of PERL_MAGIC_shared_scalar(n) magic in new thread */ int sharedsv_scalar_mg_dup(pTHX_ MAGIC *mg, CLONE_PARAMS *param) { - shared_sv *shared = (shared_sv *) mg->mg_ptr; - if (shared) { - SvREFCNT_inc(SHAREDSvPTR(shared)); - } + SvREFCNT_inc(mg->mg_ptr); return 0; } - /* * Called during local $shared */ @@ -614,10 +728,10 @@ int sharedsv_scalar_mg_local(pTHX_ SV* nsv, MAGIC *mg) { MAGIC *nmg; - shared_sv *shared = (shared_sv *) mg->mg_ptr; - if (shared) { + SV *ssv = (SV *) mg->mg_ptr; + if (ssv) { ENTER_LOCK; - SvREFCNT_inc(SHAREDSvPTR(shared)); + SvREFCNT_inc(ssv); LEAVE_LOCK; } nmg = sv_magicext(nsv, mg->mg_obj, mg->mg_type, mg->mg_virtual, @@ -632,30 +746,29 @@ MGVTBL sharedsv_scalar_vtbl = { sharedsv_scalar_mg_get, /* get */ sharedsv_scalar_mg_set, /* set */ 0, /* len */ - sharedsv_scalar_mg_clear, /* clear */ + 0, /* clear */ sharedsv_scalar_mg_free, /* free */ 0, /* copy */ sharedsv_scalar_mg_dup, /* dup */ sharedsv_scalar_mg_local /* local */ }; -/* Now the arrays/hashes stuff */ +/* ------------ PERL_MAGIC_tiedelem(p) functions -------------- */ + +/* get magic for PERL_MAGIC_tiedelem(p) */ + int sharedsv_elem_mg_FETCH(pTHX_ SV *sv, MAGIC *mg) { dTHXc; - shared_sv *shared = SV_to_sharedsv(aTHX_ mg->mg_obj); - shared_sv *target = Perl_sharedsv_find(aTHX_ sv); + SV *saggregate = S_sharedsv_from_obj(aTHX_ mg->mg_obj); SV** svp; - assert ( shared ); - assert ( SHAREDSvPTR(shared) ); - ENTER_LOCK; - if (SvTYPE(SHAREDSvPTR(shared)) == SVt_PVAV) { + if (SvTYPE(saggregate) == SVt_PVAV) { assert ( mg->mg_ptr == 0 ); SHARED_CONTEXT; - svp = av_fetch((AV*) SHAREDSvPTR(shared), mg->mg_len, 0); + svp = av_fetch((AV*) saggregate, mg->mg_len, 0); } else { char *key = mg->mg_ptr; @@ -665,21 +778,22 @@ sharedsv_elem_mg_FETCH(pTHX_ SV *sv, MAGIC *mg) key = SvPV((SV *) mg->mg_ptr, len); } SHARED_CONTEXT; - svp = hv_fetch((HV*) SHAREDSvPTR(shared), key, len, 0); + svp = hv_fetch((HV*) saggregate, key, len, 0); } CALLER_CONTEXT; if (svp) { /* Exists in the array */ if (SvROK(*svp)) { - SV *obj = Nullsv; - Perl_sharedsv_associate(aTHX_ &obj, SvRV(*svp), NULL); + SV *obj = S_sharedsv_new_private(aTHX_ SvRV(*svp)); sv_setsv_nomg(sv, &PL_sv_undef); SvRV_set(sv, obj); SvROK_on(sv); SvSETMAGIC(sv); } else { - target = Perl_sharedsv_associate(aTHX_ &sv, *svp, target); + /* XXX can this branch ever happen? DAPM */ + /* XXX assert("no such branch"); */ + Perl_sharedsv_associate(aTHX_ sv, *svp); sv_setsv(sv, *svp); } } @@ -691,24 +805,24 @@ sharedsv_elem_mg_FETCH(pTHX_ SV *sv, MAGIC *mg) return 0; } +/* set magic for PERL_MAGIC_tiedelem(p) */ + int sharedsv_elem_mg_STORE(pTHX_ SV *sv, MAGIC *mg) { dTHXc; - shared_sv *shared = SV_to_sharedsv(aTHX_ mg->mg_obj); - shared_sv *target; + SV *saggregate = S_sharedsv_from_obj(aTHX_ mg->mg_obj); SV **svp; /* Theory - SV itself is magically shared - and we have ordered the magic such that by the time we get here it has been stored to its shared counterpart */ ENTER_LOCK; - assert(shared); - assert(SHAREDSvPTR(shared)); - if (SvTYPE(SHAREDSvPTR(shared)) == SVt_PVAV) { + assert(saggregate); + if (SvTYPE(saggregate) == SVt_PVAV) { assert ( mg->mg_ptr == 0 ); SHARED_CONTEXT; - svp = av_fetch((AV*) SHAREDSvPTR(shared), mg->mg_len, 1); + svp = av_fetch((AV*) saggregate, mg->mg_len, 1); } else { char *key = mg->mg_ptr; @@ -717,28 +831,30 @@ sharedsv_elem_mg_STORE(pTHX_ SV *sv, MAGIC *mg) if (mg->mg_len == HEf_SVKEY) key = SvPV((SV *) mg->mg_ptr, len); SHARED_CONTEXT; - svp = hv_fetch((HV*) SHAREDSvPTR(shared), key, len, 1); + svp = hv_fetch((HV*) saggregate, key, len, 1); } CALLER_CONTEXT; - target = Perl_sharedsv_associate(aTHX_ &sv, *svp, 0); - sharedsv_scalar_store(aTHX_ sv, target); + Perl_sharedsv_associate(aTHX_ sv, *svp); + sharedsv_scalar_store(aTHX_ sv, *svp); LEAVE_LOCK; return 0; } +/* clear magic for PERL_MAGIC_tiedelem(p) */ + int sharedsv_elem_mg_DELETE(pTHX_ SV *sv, MAGIC *mg) { dTHXc; MAGIC *shmg; - shared_sv *shared = SV_to_sharedsv(aTHX_ mg->mg_obj); + SV *saggregate = S_sharedsv_from_obj(aTHX_ mg->mg_obj); ENTER_LOCK; sharedsv_elem_mg_FETCH(aTHX_ sv, mg); if ((shmg = mg_find(sv, PERL_MAGIC_shared_scalar))) sharedsv_scalar_mg_get(aTHX_ sv, shmg); - if (SvTYPE(SHAREDSvPTR(shared)) == SVt_PVAV) { + if (SvTYPE(saggregate) == SVt_PVAV) { SHARED_CONTEXT; - av_delete((AV*) SHAREDSvPTR(shared), mg->mg_len, G_DISCARD); + av_delete((AV*) saggregate, mg->mg_len, G_DISCARD); } else { char *key = mg->mg_ptr; @@ -747,26 +863,30 @@ sharedsv_elem_mg_DELETE(pTHX_ SV *sv, MAGIC *mg) if (mg->mg_len == HEf_SVKEY) key = SvPV((SV *) mg->mg_ptr, len); SHARED_CONTEXT; - hv_delete((HV*) SHAREDSvPTR(shared), key, len, G_DISCARD); + hv_delete((HV*) saggregate, key, len, G_DISCARD); } CALLER_CONTEXT; LEAVE_LOCK; return 0; } +/* free magic for PERL_MAGIC_tiedelem(p) */ + int sharedsv_elem_mg_free(pTHX_ SV *sv, MAGIC *mg) { - Perl_sharedsv_free(aTHX_ SV_to_sharedsv(aTHX_ mg->mg_obj)); + S_sharedsv_dec(aTHX_ S_sharedsv_from_obj(aTHX_ mg->mg_obj)); return 0; } +/* Called during cloning of PERL_MAGIC_tiedelem(p) magic in new + * thread */ + int sharedsv_elem_mg_dup(pTHX_ MAGIC *mg, CLONE_PARAMS *param) { - shared_sv *shared = SV_to_sharedsv(aTHX_ mg->mg_obj); - SvREFCNT_inc(SHAREDSvPTR(shared)); - mg->mg_flags |= MGf_DUP; + SvREFCNT_inc(S_sharedsv_from_obj(aTHX_ mg->mg_obj)); + assert(mg->mg_flags & MGf_DUP); return 0; } @@ -781,48 +901,57 @@ MGVTBL sharedsv_elem_vtbl = { 0 /* local */ }; +/* ------------ PERL_MAGIC_tied(P) functions -------------- */ + +/* len magic for PERL_MAGIC_tied(P) */ + U32 sharedsv_array_mg_FETCHSIZE(pTHX_ SV *sv, MAGIC *mg) { dTHXc; - shared_sv *shared = (shared_sv *) mg->mg_ptr; + SV *ssv = (SV *) mg->mg_ptr; U32 val; SHARED_EDIT; - if (SvTYPE(SHAREDSvPTR(shared)) == SVt_PVAV) { - val = av_len((AV*) SHAREDSvPTR(shared)); + if (SvTYPE(ssv) == SVt_PVAV) { + val = av_len((AV*) ssv); } else { /* not actually defined by tie API but ... */ - val = HvKEYS((HV*) SHAREDSvPTR(shared)); + val = HvKEYS((HV*) ssv); } SHARED_RELEASE; return val; } +/* clear magic for PERL_MAGIC_tied(P) */ + int sharedsv_array_mg_CLEAR(pTHX_ SV *sv, MAGIC *mg) { dTHXc; - shared_sv *shared = (shared_sv *) mg->mg_ptr; + SV *ssv = (SV *) mg->mg_ptr; SHARED_EDIT; - if (SvTYPE(SHAREDSvPTR(shared)) == SVt_PVAV) { - av_clear((AV*) SHAREDSvPTR(shared)); + if (SvTYPE(ssv) == SVt_PVAV) { + av_clear((AV*) ssv); } else { - hv_clear((HV*) SHAREDSvPTR(shared)); + hv_clear((HV*) ssv); } SHARED_RELEASE; return 0; } +/* free magic for PERL_MAGIC_tied(P) */ + int sharedsv_array_mg_free(pTHX_ SV *sv, MAGIC *mg) { - Perl_sharedsv_free(aTHX_ (shared_sv *) mg->mg_ptr); + S_sharedsv_dec(aTHX_ (SV*)mg->mg_ptr); return 0; } /* + * copy magic for PERL_MAGIC_tied(P) * This is called when perl is about to access an element of * the array - */ @@ -830,23 +959,23 @@ int sharedsv_array_mg_copy(pTHX_ SV *sv, MAGIC* mg, SV *nsv, const char *name, int namlen) { - shared_sv *shared = (shared_sv *) mg->mg_ptr; MAGIC *nmg = sv_magicext(nsv,mg->mg_obj, toLOWER(mg->mg_type),&sharedsv_elem_vtbl, name, namlen); ENTER_LOCK; - SvREFCNT_inc(SHAREDSvPTR(shared)); + SvREFCNT_inc((SV*)mg->mg_ptr); LEAVE_LOCK; nmg->mg_flags |= MGf_DUP; return 1; } +/* Called during cloning of PERL_MAGIC_tied(P) magic in new thread */ + int sharedsv_array_mg_dup(pTHX_ MAGIC *mg, CLONE_PARAMS *param) { - shared_sv *shared = (shared_sv *) mg->mg_ptr; - SvREFCNT_inc(SHAREDSvPTR(shared)); - mg->mg_flags |= MGf_DUP; + SvREFCNT_inc((SV*)mg->mg_ptr); + assert(mg->mg_flags & MGf_DUP); return 0; } @@ -868,9 +997,11 @@ Recursively unlocks a shared sv. =cut void -Perl_sharedsv_unlock(pTHX_ shared_sv* ssv) +Perl_sharedsv_unlock(pTHX_ SV *ssv) { - recursive_lock_release(aTHX_ &ssv->lock); + user_lock *ul = S_get_userlock(aTHX_ ssv, 0); + assert(ul); + recursive_lock_release(aTHX_ &ul->lock); } =for apidoc sharedsv_lock @@ -881,11 +1012,13 @@ Locks are dynamically scoped at the level of the first lock. =cut void -Perl_sharedsv_lock(pTHX_ shared_sv* ssv) +Perl_sharedsv_lock(pTHX_ SV *ssv) { + user_lock *ul; if (!ssv) return; - recursive_lock_acquire(aTHX_ &ssv->lock, __FILE__, __LINE__); + ul = S_get_userlock(aTHX_ ssv, 1); + recursive_lock_acquire(aTHX_ &ul->lock, __FILE__, __LINE__); } /* handles calls from lock() builtin via PL_lockhook */ @@ -893,14 +1026,14 @@ Perl_sharedsv_lock(pTHX_ shared_sv* ssv) void Perl_sharedsv_locksv(pTHX_ SV *sv) { - shared_sv* shared; + SV *ssv; if(SvROK(sv)) sv = SvRV(sv); - shared = Perl_sharedsv_find(aTHX_ sv); - if(!shared) + ssv = Perl_sharedsv_find(aTHX_ sv); + if(!ssv) croak("lock can only be used on shared values"); - Perl_sharedsv_lock(aTHX_ shared); + Perl_sharedsv_lock(aTHX_ ssv); } =head1 Shared SV Functions @@ -933,107 +1066,114 @@ PROTOTYPES: DISABLE #ifdef USE_ITHREADS void -PUSH(shared_sv *shared, ...) +PUSH(SV *obj, ...) CODE: dTHXc; + SV *sobj = S_sharedsv_from_obj(aTHX_ obj); int i; for(i = 1; i < items; i++) { SV* tmp = newSVsv(ST(i)); - shared_sv *target; + SV *stmp; ENTER_LOCK; - target = Perl_sharedsv_associate(aTHX_ &tmp, Nullsv, 0); - sharedsv_scalar_store(aTHX_ tmp, target); + stmp = S_sharedsv_new_shared(aTHX_ tmp); + sharedsv_scalar_store(aTHX_ tmp, stmp); SHARED_CONTEXT; - av_push((AV*) SHAREDSvPTR(shared), SHAREDSvPTR(target)); - SvREFCNT_inc(SHAREDSvPTR(target)); + av_push((AV*) sobj, stmp); + SvREFCNT_inc(stmp); SHARED_RELEASE; SvREFCNT_dec(tmp); } void -UNSHIFT(shared_sv *shared, ...) +UNSHIFT(SV *obj, ...) CODE: dTHXc; + SV *sobj = S_sharedsv_from_obj(aTHX_ obj); int i; ENTER_LOCK; SHARED_CONTEXT; - av_unshift((AV*)SHAREDSvPTR(shared), items - 1); + av_unshift((AV*)sobj, items - 1); CALLER_CONTEXT; for(i = 1; i < items; i++) { - SV* tmp = newSVsv(ST(i)); - shared_sv *target = Perl_sharedsv_associate(aTHX_ &tmp, Nullsv, 0); - sharedsv_scalar_store(aTHX_ tmp, target); + SV *tmp = newSVsv(ST(i)); + SV *stmp = S_sharedsv_new_shared(aTHX_ tmp); + sharedsv_scalar_store(aTHX_ tmp, stmp); SHARED_CONTEXT; - av_store((AV*) SHAREDSvPTR(shared), i - 1, SHAREDSvPTR(target)); - SvREFCNT_inc(SHAREDSvPTR(target)); + av_store((AV*) sobj, i - 1, stmp); + SvREFCNT_inc(stmp); CALLER_CONTEXT; SvREFCNT_dec(tmp); } LEAVE_LOCK; void -POP(shared_sv *shared) +POP(SV *obj) CODE: dTHXc; - SV* sv; + SV *sobj = S_sharedsv_from_obj(aTHX_ obj); + SV* ssv; ENTER_LOCK; SHARED_CONTEXT; - sv = av_pop((AV*)SHAREDSvPTR(shared)); + ssv = av_pop((AV*)sobj); CALLER_CONTEXT; ST(0) = sv_newmortal(); - Perl_sharedsv_associate(aTHX_ &ST(0), sv, 0); - SvREFCNT_dec(sv); + Perl_sharedsv_associate(aTHX_ ST(0), ssv); + SvREFCNT_dec(ssv); LEAVE_LOCK; XSRETURN(1); void -SHIFT(shared_sv *shared) +SHIFT(SV *obj) CODE: dTHXc; - SV* sv; + SV *sobj = S_sharedsv_from_obj(aTHX_ obj); + SV* ssv; ENTER_LOCK; SHARED_CONTEXT; - sv = av_shift((AV*)SHAREDSvPTR(shared)); + ssv = av_shift((AV*)sobj); CALLER_CONTEXT; ST(0) = sv_newmortal(); - Perl_sharedsv_associate(aTHX_ &ST(0), sv, 0); - SvREFCNT_dec(sv); + Perl_sharedsv_associate(aTHX_ ST(0), ssv); + SvREFCNT_dec(ssv); LEAVE_LOCK; XSRETURN(1); void -EXTEND(shared_sv *shared, IV count) +EXTEND(SV *obj, IV count) CODE: dTHXc; + SV *sobj = S_sharedsv_from_obj(aTHX_ obj); SHARED_EDIT; - av_extend((AV*)SHAREDSvPTR(shared), count); + av_extend((AV*)sobj, count); SHARED_RELEASE; void -STORESIZE(shared_sv *shared,IV count) +STORESIZE(SV *obj,IV count) CODE: dTHXc; + SV *sobj = S_sharedsv_from_obj(aTHX_ obj); SHARED_EDIT; - av_fill((AV*) SHAREDSvPTR(shared), count); + av_fill((AV*) sobj, count); SHARED_RELEASE; void -EXISTS(shared_sv *shared, SV *index) +EXISTS(SV *obj, SV *index) CODE: dTHXc; + SV *sobj = S_sharedsv_from_obj(aTHX_ obj); bool exists; - if (SvTYPE(SHAREDSvPTR(shared)) == SVt_PVAV) { + if (SvTYPE(sobj) == SVt_PVAV) { SHARED_EDIT; - exists = av_exists((AV*) SHAREDSvPTR(shared), SvIV(index)); + exists = av_exists((AV*) sobj, SvIV(index)); } else { STRLEN len; char *key = SvPV(index,len); SHARED_EDIT; - exists = hv_exists((HV*) SHAREDSvPTR(shared), key, len); + exists = hv_exists((HV*) sobj, key, len); } SHARED_RELEASE; ST(0) = (exists) ? &PL_sv_yes : &PL_sv_no; @@ -1041,16 +1181,17 @@ CODE: void -FIRSTKEY(shared_sv *shared) +FIRSTKEY(SV *obj) CODE: dTHXc; + SV *sobj = S_sharedsv_from_obj(aTHX_ obj); char* key = NULL; I32 len = 0; HE* entry; ENTER_LOCK; SHARED_CONTEXT; - hv_iterinit((HV*) SHAREDSvPTR(shared)); - entry = hv_iternext((HV*) SHAREDSvPTR(shared)); + hv_iterinit((HV*) sobj); + entry = hv_iternext((HV*) sobj); if (entry) { key = hv_iterkey(entry,&len); CALLER_CONTEXT; @@ -1063,15 +1204,16 @@ CODE: XSRETURN(1); void -NEXTKEY(shared_sv *shared, SV *oldkey) +NEXTKEY(SV *obj, SV *oldkey) CODE: dTHXc; + SV *sobj = S_sharedsv_from_obj(aTHX_ obj); char* key = NULL; I32 len = 0; HE* entry; ENTER_LOCK; SHARED_CONTEXT; - entry = hv_iternext((HV*) SHAREDSvPTR(shared)); + entry = hv_iternext((HV*) sobj); if (entry) { key = hv_iterkey(entry,&len); CALLER_CONTEXT; @@ -1091,12 +1233,12 @@ void _id(SV *ref) PROTOTYPE: \[$@%] CODE: - shared_sv *shared; + SV *ssv; ref = SvRV(ref); if(SvROK(ref)) ref = SvRV(ref); - if( (shared = Perl_sharedsv_find(aTHX_ ref)) ){ - ST(0) = sv_2mortal(newSViv(PTR2IV(shared))); + if( (ssv = Perl_sharedsv_find(aTHX_ ref)) ){ + ST(0) = sv_2mortal(newSViv(PTR2IV(ssv))); XSRETURN(1); } XSRETURN_UNDEF; @@ -1106,18 +1248,13 @@ void _refcnt(SV *ref) PROTOTYPE: \[$@%] CODE: - shared_sv *shared; + SV *ssv; ref = SvRV(ref); if(SvROK(ref)) ref = SvRV(ref); - if( (shared = Perl_sharedsv_find(aTHX_ ref)) ){ - if (SHAREDSvPTR(shared)) { - ST(0) = sv_2mortal(newSViv(SvREFCNT(SHAREDSvPTR(shared)))); + if( (ssv = Perl_sharedsv_find(aTHX_ ref)) ) { + ST(0) = sv_2mortal(newSViv(SvREFCNT(ssv))); XSRETURN(1); - } - else { - Perl_warn(aTHX_ "%" SVf " s=%p has no shared SV",ST(0),shared); - } } else { Perl_warn(aTHX_ "%" SVf " is not shared",ST(0)); @@ -1142,25 +1279,26 @@ void lock_enabled(SV *ref) PROTOTYPE: \[$@%] CODE: - shared_sv* shared; + SV *ssv; if(!SvROK(ref)) Perl_croak(aTHX_ "Argument to lock needs to be passed as ref"); ref = SvRV(ref); if(SvROK(ref)) ref = SvRV(ref); - shared = Perl_sharedsv_find(aTHX_ ref); - if(!shared) + ssv = Perl_sharedsv_find(aTHX_ ref); + if(!ssv) croak("lock can only be used on shared values"); - Perl_sharedsv_lock(aTHX_ shared); + Perl_sharedsv_lock(aTHX_ ssv); void cond_wait_enabled(SV *ref_cond, SV *ref_lock = 0) PROTOTYPE: \[$@%];\[$@%] PREINIT: - shared_sv* shared; + SV *ssv; perl_cond* user_condition; int locks; int same = 0; + user_lock *ul; CODE: if (!ref_lock || ref_lock == ref_cond) same = 1; @@ -1170,48 +1308,51 @@ cond_wait_enabled(SV *ref_cond, SV *ref_lock = 0) ref_cond = SvRV(ref_cond); if(SvROK(ref_cond)) ref_cond = SvRV(ref_cond); - shared = Perl_sharedsv_find(aTHX_ ref_cond); - if(!shared) + ssv = Perl_sharedsv_find(aTHX_ ref_cond); + if(!ssv) croak("cond_wait can only be used on shared values"); + ul = S_get_userlock(aTHX_ ssv, 1); - user_condition = &shared->user_cond; + user_condition = &ul->user_cond; if (! same) { if (!SvROK(ref_lock)) Perl_croak(aTHX_ "cond_wait lock needs to be passed as ref"); ref_lock = SvRV(ref_lock); if (SvROK(ref_lock)) ref_lock = SvRV(ref_lock); - shared = Perl_sharedsv_find(aTHX_ ref_lock); - if (!shared) + ssv = Perl_sharedsv_find(aTHX_ ref_lock); + if (!ssv) croak("cond_wait lock must be a shared value"); + ul = S_get_userlock(aTHX_ ssv, 1); } - if(shared->lock.owner != aTHX) + if(ul->lock.owner != aTHX) croak("You need a lock before you can cond_wait"); /* Stealing the members of the lock object worries me - NI-S */ - MUTEX_LOCK(&shared->lock.mutex); - shared->lock.owner = NULL; - locks = shared->lock.locks; - shared->lock.locks = 0; + 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(&shared->lock.cond); - COND_WAIT(user_condition, &shared->lock.mutex); - while(shared->lock.owner != NULL) { + COND_SIGNAL(&ul->lock.cond); + COND_WAIT(user_condition, &ul->lock.mutex); + while(ul->lock.owner != NULL) { /* OK -- must reacquire the lock */ - COND_WAIT(&shared->lock.cond, &shared->lock.mutex); + COND_WAIT(&ul->lock.cond, &ul->lock.mutex); } - shared->lock.owner = aTHX; - shared->lock.locks = locks; - MUTEX_UNLOCK(&shared->lock.mutex); + ul->lock.owner = aTHX; + ul->lock.locks = locks; + MUTEX_UNLOCK(&ul->lock.mutex); int cond_timedwait_enabled(SV *ref_cond, double abs, SV *ref_lock = 0) PROTOTYPE: \[$@%]$;\[$@%] PREINIT: - shared_sv* shared; + SV *ssv; perl_cond* user_condition; int locks; int same = 0; + user_lock *ul; CODE: if (!ref_lock || ref_cond == ref_lock) same = 1; @@ -1221,38 +1362,40 @@ cond_timedwait_enabled(SV *ref_cond, double abs, SV *ref_lock = 0) ref_cond = SvRV(ref_cond); if(SvROK(ref_cond)) ref_cond = SvRV(ref_cond); - shared = Perl_sharedsv_find(aTHX_ ref_cond); - if(!shared) + ssv = Perl_sharedsv_find(aTHX_ ref_cond); + if(!ssv) croak("cond_timedwait can only be used on shared values"); + ul = S_get_userlock(aTHX_ ssv, 1); - user_condition = &shared->user_cond; + user_condition = &ul->user_cond; if (! same) { 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); - shared = Perl_sharedsv_find(aTHX_ ref_lock); - if (!shared) + 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(shared->lock.owner != aTHX) + if(ul->lock.owner != aTHX) croak("You need a lock before you can cond_wait"); - MUTEX_LOCK(&shared->lock.mutex); - shared->lock.owner = NULL; - locks = shared->lock.locks; - shared->lock.locks = 0; + 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(&shared->lock.cond); - RETVAL = Perl_sharedsv_cond_timedwait(user_condition, &shared->lock.mutex, abs); - while (shared->lock.owner != NULL) { + 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(&shared->lock.cond, &shared->lock.mutex); + COND_WAIT(&ul->lock.cond, &ul->lock.mutex); } - shared->lock.owner = aTHX; - shared->lock.locks = locks; - MUTEX_UNLOCK(&shared->lock.mutex); + ul->lock.owner = aTHX; + ul->lock.locks = locks; + MUTEX_UNLOCK(&ul->lock.mutex); if (RETVAL == 0) XSRETURN_UNDEF; @@ -1263,37 +1406,43 @@ void cond_signal_enabled(SV *ref) PROTOTYPE: \[$@%] CODE: - shared_sv* shared; + 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); - shared = Perl_sharedsv_find(aTHX_ ref); - if(!shared) + ssv = Perl_sharedsv_find(aTHX_ ref); + if(!ssv) croak("cond_signal can only be used on shared values"); - if (ckWARN(WARN_THREADS) && shared->lock.owner != aTHX) + 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(&shared->user_cond); + COND_SIGNAL(&ul->user_cond); void cond_broadcast_enabled(SV *ref) PROTOTYPE: \[$@%] CODE: - shared_sv* shared; + 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); - shared = Perl_sharedsv_find(aTHX_ ref); - if(!shared) + ssv = Perl_sharedsv_find(aTHX_ ref); + if(!ssv) croak("cond_broadcast can only be used on shared values"); - if (ckWARN(WARN_THREADS) && shared->lock.owner != aTHX) + 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(&shared->user_cond); + COND_BROADCAST(&ul->user_cond); SV* @@ -1302,17 +1451,18 @@ bless(SV* ref, ...); CODE: { HV* stash; - shared_sv* shared; + SV *ssv; if (items == 1) stash = CopSTASH(PL_curcop); else { - SV* ssv = ST(1); + SV* classname = ST(1); STRLEN len; char *ptr; - if (ssv && !SvGMAGICAL(ssv) && !SvAMAGIC(ssv) && SvROK(ssv)) + if (classname && !SvGMAGICAL(classname) && + !SvAMAGIC(classname) && SvROK(classname)) Perl_croak(aTHX_ "Attempt to bless into a reference"); - ptr = SvPV(ssv,len); + ptr = SvPV(classname,len); if (ckWARN(WARN_MISC) && len == 0) Perl_warner(aTHX_ packWARN(WARN_MISC), "Explicit blessing to '' (assuming package main)"); @@ -1321,14 +1471,14 @@ bless(SV* ref, ...); SvREFCNT_inc(ref); (void)sv_bless(ref, stash); RETVAL = ref; - shared = Perl_sharedsv_find(aTHX_ ref); - if(shared) { + ssv = Perl_sharedsv_find(aTHX_ ref); + if(ssv) { dTHXc; ENTER_LOCK; SHARED_CONTEXT; { SV* fake_stash = newSVpv(HvNAME_get(stash),0); - (void)sv_bless(SHAREDSvPTR(shared),(HV*)fake_stash); + (void)sv_bless(ssv,(HV*)fake_stash); } CALLER_CONTEXT; LEAVE_LOCK; @@ -1345,6 +1495,3 @@ BOOT: Perl_sharedsv_init(aTHX); #endif /* USE_ITHREADS */ } - - - diff --git a/ext/threads/shared/typemap b/ext/threads/shared/typemap index 0202d04..e69de29 100644 --- a/ext/threads/shared/typemap +++ b/ext/threads/shared/typemap @@ -1,7 +0,0 @@ -shared_sv * T_SHAREDSV - -INPUT -T_SHAREDSV - $var = SV_to_sharedsv(aTHX_ $arg) - -