- case SVt_PVHV: {
- SV* weakref;
- SV* obj_ref = newSViv(0);
- SV* obj = newSVrv(obj_ref,"threads::shared::hv");
- HV* hv = newHV();
- sv_setiv(obj,(IV)shared);
- weakref = newRV((SV*)hv);
- sv = newRV_noinc((SV*)hv);
- sv_rvweaken(weakref);
- sv_magic((SV*) hv, obj_ref, PERL_MAGIC_tied, Nullch, 0);
- hv_store(shared_hv, SvPV(id,length), length, weakref, 0);
- Perl_sharedsv_thrcnt_inc(aTHX_ shared);
+ 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 (shared_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 NULL;
+}
+
+/*
+ * Almost all the pain is in this routine.
+ *
+ */
+
+shared_sv *
+Perl_sharedsv_associate(pTHX_ SV **psv, SV *ssv, shared_sv *data)
+{
+ dTHXc;
+ MAGIC *mg = 0;
+ SV *sv = (psv) ? *psv : Nullsv;
+
+ /* If we are asked for an 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 */
+
+ /* 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;
+ }
+ }
+
+ /* 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 = 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;
+ }
+
+ if (!ssv)
+ ssv = SHAREDSvPTR(data);
+ if (!SHAREDSvPTR(data))
+ SHAREDSvPTR(data) = 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;
+ }
+
+ /* Now if requested allocate private SV */
+ if (psv && !sv) {
+ *psv = sv = newSV(0);
+ }
+
+ /* 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(sv) = (HV*)SvREFCNT_inc(stash);
+ }