8 SV* shared_sv_attach_sv (SV* sv, shared_sv* shared) {
9 HV* shared_hv = get_hv("threads::shared::shared", FALSE);
10 SV* id = newSViv(PTR2IV(shared));
11 STRLEN length = sv_len(id);
13 SV** tiedobject_ = hv_fetch(shared_hv, SvPV(id,length), length, 0);
15 tiedobject = (*tiedobject_);
18 SvRV(sv) = SvRV(tiedobject);
20 sv = newRV(SvRV(tiedobject));
23 switch(SvTYPE(SHAREDSvGET(shared))) {
26 SV* obj_ref = newSViv(0);
27 SV* obj = newSVrv(obj_ref,"threads::shared::av");
29 sv_setiv(obj,PTR2IV(shared));
30 weakref = newRV((SV*)hv);
31 sv = newRV_noinc((SV*)hv);
33 sv_magic((SV*) hv, obj_ref, PERL_MAGIC_tied, Nullch, 0);
34 hv_store(shared_hv, SvPV(id,length), length, weakref, 0);
35 Perl_sharedsv_thrcnt_inc(aTHX_ shared);
40 SV* obj_ref = newSViv(0);
41 SV* obj = newSVrv(obj_ref,"threads::shared::hv");
43 sv_setiv(obj,PTR2IV(shared));
44 weakref = newRV((SV*)hv);
45 sv = newRV_noinc((SV*)hv);
47 sv_magic((SV*) hv, obj_ref, PERL_MAGIC_tied, Nullch, 0);
48 hv_store(shared_hv, SvPV(id,length), length, weakref, 0);
49 Perl_sharedsv_thrcnt_inc(aTHX_ shared);
54 SV* value = newSVsv(SHAREDSvGET(shared));
55 SV* obj = newSViv(PTR2IV(shared));
56 sv_magic(value, 0, PERL_MAGIC_ext, "threads::shared", 16);
57 shared_magic = mg_find(value, PERL_MAGIC_ext);
58 shared_magic->mg_virtual = &svtable;
59 shared_magic->mg_obj = newSViv(PTR2IV(shared));
60 shared_magic->mg_flags |= MGf_REFCOUNTED;
61 shared_magic->mg_private = 0;
63 sv = newRV_noinc(value);
66 hv_store(shared_hv, SvPV(id,length),length, value, 0);
67 Perl_sharedsv_thrcnt_inc(aTHX_ shared);
76 int shared_sv_fetch_mg (pTHX_ SV* sv, MAGIC *mg) {
77 shared_sv* shared = INT2PTR(shared_sv*, SvIV(mg->mg_obj));
79 if(mg->mg_private != shared->index) {
80 if(SvROK(SHAREDSvGET(shared))) {
81 shared_sv* target = INT2PTR(shared_sv*, SvIV(SvRV(SHAREDSvGET(shared))));
82 shared_sv_attach_sv(sv, target);
84 sv_setsv(sv, SHAREDSvGET(shared));
86 mg->mg_private = shared->index;
88 SHAREDSvUNLOCK(shared);
93 int shared_sv_store_mg (pTHX_ SV* sv, MAGIC *mg) {
94 shared_sv* shared = INT2PTR(shared_sv*, SvIV(mg->mg_obj));
96 if(SvROK(SHAREDSvGET(shared)))
97 Perl_sharedsv_thrcnt_dec(aTHX_ INT2PTR(shared_sv*, SvIV(SvRV(SHAREDSvGET(shared)))));
99 shared_sv* target = Perl_sharedsv_find(aTHX_ SvRV(sv));
101 sv_setsv(sv,SHAREDSvGET(shared));
102 SHAREDSvUNLOCK(shared);
103 Perl_croak(aTHX_ "You cannot assign a non shared reference to a shared scalar");
105 SHAREDSvEDIT(shared);
106 Perl_sv_free(PL_sharedsv_space,SHAREDSvGET(shared));
107 SHAREDSvGET(shared) = newRV_noinc(newSViv(PTR2IV(target)));
109 SHAREDSvEDIT(shared);
110 sv_setsv(SHAREDSvGET(shared), sv);
113 mg->mg_private = shared->index;
114 SHAREDSvRELEASE(shared);
115 if(SvROK(SHAREDSvGET(shared)))
116 Perl_sharedsv_thrcnt_inc(aTHX_ INT2PTR(shared_sv*, SvIV(SvRV(SHAREDSvGET(shared)))));
117 SHAREDSvUNLOCK(shared);
121 int shared_sv_destroy_mg (pTHX_ SV* sv, MAGIC *mg) {
122 shared_sv* shared = INT2PTR(shared_sv*, SvIV(mg->mg_obj));
126 HV* shared_hv = get_hv("threads::shared::shared", FALSE);
127 SV* id = newSViv(PTR2IV(shared));
128 STRLEN length = sv_len(id);
129 hv_delete(shared_hv, SvPV(id,length), length,0);
131 Perl_sharedsv_thrcnt_dec(aTHX_ shared);
134 MGVTBL svtable = {MEMBER_TO_FPTR(shared_sv_fetch_mg),
135 MEMBER_TO_FPTR(shared_sv_store_mg),
138 MEMBER_TO_FPTR(shared_sv_destroy_mg)
141 MODULE = threads::shared PACKAGE = threads::shared
151 RETVAL = newSViv(SvIV(SvRV(ref)));
163 shared = Perl_sharedsv_find(aTHX, ref);
165 croak("thrcnt can only be used on shared values");
166 SHAREDSvLOCK(shared);
167 RETVAL = newSViv(SvREFCNT(SHAREDSvGET(shared)));
168 SHAREDSvUNLOCK(shared);
179 PerlInterpreter* origperl = INT2PTR(PerlInterpreter*, SvIV(perl));
180 PerlInterpreter* oldperl = PERL_GET_CONTEXT;
183 shared = Perl_sharedsv_find(aTHX, ref);
185 croak("thrcnt can only be used on shared values");
186 PERL_SET_CONTEXT(origperl);
187 Perl_sharedsv_thrcnt_inc(aTHX_ shared);
188 PERL_SET_CONTEXT(oldperl);
194 shared_sv* shared = INT2PTR(shared_sv*, SvIV(ref));
196 croak("thrcnt can only be used on shared values");
197 Perl_sharedsv_thrcnt_dec(aTHX_ shared);
207 shared = Perl_sharedsv_find(aTHX, ref);
209 croak("unlock can only be used on shared values");
210 SHAREDSvUNLOCK(shared);
219 shared = Perl_sharedsv_find(aTHX, ref);
221 croak("lock can only be used on shared values");
222 SHAREDSvLOCK(shared);
226 cond_wait_enabled(ref)
234 shared = Perl_sharedsv_find(aTHX_ ref);
236 croak("cond_wait can only be used on shared values");
237 if(shared->owner != PERL_GET_CONTEXT)
238 croak("You need a lock before you can cond_wait");
239 MUTEX_LOCK(&shared->mutex);
240 shared->owner = NULL;
241 locks = shared->locks = 0;
242 COND_WAIT(&shared->user_cond, &shared->mutex);
243 shared->owner = PERL_GET_CONTEXT;
244 shared->locks = locks;
245 MUTEX_UNLOCK(&shared->mutex);
247 void cond_signal_enabled(ref)
254 shared = Perl_sharedsv_find(aTHX_ ref);
256 croak("cond_signal can only be used on shared values");
257 COND_SIGNAL(&shared->user_cond);
260 void cond_broadcast_enabled(ref)
267 shared = Perl_sharedsv_find(aTHX_ ref);
269 croak("cond_broadcast can only be used on shared values");
270 COND_BROADCAST(&shared->user_cond);
272 MODULE = threads::shared PACKAGE = threads::shared::sv
279 shared_sv* shared = Perl_sharedsv_new(aTHX);
281 SV* obj = newSViv(PTR2IV(shared));
282 SHAREDSvEDIT(shared);
283 SHAREDSvGET(shared) = newSVsv(value);
284 SHAREDSvRELEASE(shared);
285 sv_magic(value, 0, PERL_MAGIC_ext, "threads::shared", 16);
286 shared_magic = mg_find(value, PERL_MAGIC_ext);
287 shared_magic->mg_virtual = &svtable;
288 shared_magic->mg_obj = newSViv(PTR2IV(shared));
289 shared_magic->mg_flags |= MGf_REFCOUNTED;
290 shared_magic->mg_private = 0;
297 MODULE = threads::shared PACKAGE = threads::shared::av
304 shared_sv* shared = Perl_sharedsv_new(aTHX);
305 SV* obj = newSViv(PTR2IV(shared));
306 SHAREDSvEDIT(shared);
307 SHAREDSvGET(shared) = (SV*) newAV();
308 SHAREDSvRELEASE(shared);
314 STORE(self, index, value)
319 shared_sv* shared = INT2PTR(shared_sv*, SvIV(SvRV(self)));
324 shared_sv* target = Perl_sharedsv_find(aTHX_ SvRV(value));
326 Perl_croak(aTHX_ "You cannot assign a non shared reference to a shared array");
328 value = newRV_noinc(newSViv(PTR2IV(target)));
330 SHAREDSvLOCK(shared);
331 aentry_ = av_fetch((AV*) SHAREDSvGET(shared), SvIV(index), 0);
332 if(aentry_ && SvIV((*aentry_))) {
334 slot = INT2PTR(shared_sv*, SvIV(aentry));
335 if(SvROK(SHAREDSvGET(slot)))
336 Perl_sharedsv_thrcnt_dec(aTHX_ INT2PTR(shared_sv*, SvIV(SvRV(SHAREDSvGET(slot)))));
338 sv_setsv(SHAREDSvGET(slot), value);
339 SHAREDSvRELEASE(slot);
341 slot = Perl_sharedsv_new(aTHX);
342 SHAREDSvEDIT(shared);
343 SHAREDSvGET(slot) = newSVsv(value);
344 aentry = newSViv(PTR2IV(slot));
345 av_store((AV*) SHAREDSvGET(shared), SvIV(index), aentry);
346 SHAREDSvRELEASE(shared);
348 if(SvROK(SHAREDSvGET(slot)))
349 Perl_sharedsv_thrcnt_inc(aTHX_ INT2PTR(shared_sv*, SvIV(SvRV(SHAREDSvGET(slot)))));
351 SHAREDSvUNLOCK(shared);
358 shared_sv* shared = INT2PTR(shared_sv*, SvIV(SvRV(self)));
363 SHAREDSvLOCK(shared);
364 aentry_ = av_fetch((AV*) SHAREDSvGET(shared), SvIV(index),0);
367 if(SvTYPE(aentry) == SVt_NULL) {
368 retval = &PL_sv_undef;
370 slot = INT2PTR(shared_sv*, SvIV(aentry));
371 if(SvROK(SHAREDSvGET(slot))) {
372 shared_sv* target = INT2PTR(shared_sv*, SvIV(SvRV(SHAREDSvGET(slot))));
373 retval = shared_sv_attach_sv(NULL,target);
375 retval = newSVsv(SHAREDSvGET(slot));
379 retval = &PL_sv_undef;
381 SHAREDSvUNLOCK(shared);
390 shared_sv* shared = INT2PTR(shared_sv*, SvIV(SvRV(self)));
392 SHAREDSvLOCK(shared);
393 for(i = 1; i < items; i++) {
394 shared_sv* slot = Perl_sharedsv_new(aTHX);
397 shared_sv* target = Perl_sharedsv_find(aTHX_ SvRV(tmp));
399 Perl_croak(aTHX_ "You cannot assign a non shared reference to a shared array");
401 tmp = newRV_noinc(newSViv(PTR2IV(target)));
404 SHAREDSvGET(slot) = newSVsv(tmp);
405 av_push((AV*) SHAREDSvGET(shared), newSViv(PTR2IV(slot)));
406 SHAREDSvRELEASE(slot);
407 if(SvROK(SHAREDSvGET(slot)))
408 Perl_sharedsv_thrcnt_inc(aTHX_ INT2PTR(shared_sv*, SvIV(SvRV(SHAREDSvGET(slot)))));
410 SHAREDSvUNLOCK(shared);
416 shared_sv* shared = INT2PTR(shared_sv*, SvIV(SvRV(self)));
418 SHAREDSvLOCK(shared);
419 SHAREDSvEDIT(shared);
420 av_unshift((AV*)SHAREDSvGET(shared), items - 1);
421 SHAREDSvRELEASE(shared);
422 for(i = 1; i < items; i++) {
423 shared_sv* slot = Perl_sharedsv_new(aTHX);
426 shared_sv* target = Perl_sharedsv_find(aTHX_ SvRV(tmp));
428 Perl_croak(aTHX_ "You cannot assign a non shared reference to a shared array");
430 tmp = newRV_noinc(newSViv(PTR2IV(target)));
433 SHAREDSvGET(slot) = newSVsv(tmp);
434 av_store((AV*) SHAREDSvGET(shared), i - 1, newSViv(PTR2IV(slot)));
435 SHAREDSvRELEASE(slot);
436 if(SvROK(SHAREDSvGET(slot)))
437 Perl_sharedsv_thrcnt_inc(aTHX_ INT2PTR(shared_sv*, SvIV(SvRV(SHAREDSvGET(slot)))));
439 SHAREDSvUNLOCK(shared);
445 shared_sv* shared = INT2PTR(shared_sv*, SvIV(SvRV(self)));
448 SHAREDSvLOCK(shared);
449 SHAREDSvEDIT(shared);
450 retval = av_pop((AV*)SHAREDSvGET(shared));
451 SHAREDSvRELEASE(shared);
452 if(retval && SvIV(retval)) {
453 slot = INT2PTR(shared_sv*, SvIV(retval));
454 if(SvROK(SHAREDSvGET(slot))) {
455 shared_sv* target = INT2PTR(shared_sv*, SvIV(SvRV(SHAREDSvGET(slot))));
456 retval = shared_sv_attach_sv(NULL,target);
458 retval = newSVsv(SHAREDSvGET(slot));
460 Perl_sharedsv_thrcnt_dec(aTHX_ slot);
462 retval = &PL_sv_undef;
464 SHAREDSvUNLOCK(shared);
474 shared_sv* shared = INT2PTR(shared_sv*, SvIV(SvRV(self)));
477 SHAREDSvLOCK(shared);
478 SHAREDSvEDIT(shared);
479 retval = av_shift((AV*)SHAREDSvGET(shared));
480 SHAREDSvRELEASE(shared);
481 if(retval && SvIV(retval)) {
482 slot = INT2PTR(shared_sv*, SvIV(retval));
483 if(SvROK(SHAREDSvGET(slot))) {
484 shared_sv* target = INT2PTR(shared_sv*, SvIV(SvRV(SHAREDSvGET(slot))));
485 retval = shared_sv_attach_sv(NULL,target);
487 retval = newSVsv(SHAREDSvGET(slot));
489 Perl_sharedsv_thrcnt_dec(aTHX_ slot);
491 retval = &PL_sv_undef;
493 SHAREDSvUNLOCK(shared);
502 shared_sv* shared = INT2PTR(shared_sv*, SvIV(SvRV(self)));
506 SHAREDSvLOCK(shared);
507 svp = AvARRAY((AV*)SHAREDSvGET(shared));
508 i = AvFILLp((AV*)SHAREDSvGET(shared));
511 Perl_sharedsv_thrcnt_dec(aTHX_ INT2PTR(shared_sv*, SvIV(svp[i])));
515 SHAREDSvEDIT(shared);
516 av_clear((AV*)SHAREDSvGET(shared));
517 SHAREDSvRELEASE(shared);
518 SHAREDSvUNLOCK(shared);
525 shared_sv* shared = INT2PTR(shared_sv*, SvIV(SvRV(self)));
526 SHAREDSvEDIT(shared);
527 av_extend((AV*)SHAREDSvGET(shared), (I32) SvIV(count));
528 SHAREDSvRELEASE(shared);
538 shared_sv* shared = INT2PTR(shared_sv*, SvIV(SvRV(self)));
540 SHAREDSvLOCK(shared);
541 exists = av_exists((AV*) SHAREDSvGET(shared), (I32) SvIV(index));
547 SHAREDSvUNLOCK(shared);
550 STORESIZE(self,count)
554 shared_sv* shared = INT2PTR(shared_sv*, SvIV(SvRV(self)));
555 SHAREDSvEDIT(shared);
556 av_fill((AV*) SHAREDSvGET(shared), (I32) SvIV(count));
557 SHAREDSvRELEASE(shared);
563 shared_sv* shared = INT2PTR(shared_sv*, SvIV(SvRV(self)));
564 SHAREDSvLOCK(shared);
565 RETVAL = newSViv(av_len((AV*) SHAREDSvGET(shared)) + 1);
566 SHAREDSvUNLOCK(shared);
575 shared_sv* shared = INT2PTR(shared_sv*, SvIV(SvRV(self)));
577 SHAREDSvLOCK(shared);
578 if(av_exists((AV*) SHAREDSvGET(shared), (I32) SvIV(index))) {
580 SHAREDSvEDIT(shared);
581 tmp = av_delete((AV*)SHAREDSvGET(shared), (I32) SvIV(index),0);
582 SHAREDSvRELEASE(shared);
584 slot = INT2PTR(shared_sv*, SvIV(tmp));
585 if(SvROK(SHAREDSvGET(slot))) {
586 shared_sv* target = INT2PTR(shared_sv*, SvIV(SvRV(SHAREDSvGET(slot))));
587 RETVAL = shared_sv_attach_sv(NULL,target);
589 RETVAL = newSVsv(SHAREDSvGET(slot));
591 Perl_sharedsv_thrcnt_dec(aTHX_ slot);
593 RETVAL = &PL_sv_undef;
596 RETVAL = &PL_sv_undef;
598 SHAREDSvUNLOCK(shared);
603 SPLICE(self, offset, length, ...)
608 croak("Splice is not implmented for shared arrays");
610 MODULE = threads::shared PACKAGE = threads::shared::hv
617 shared_sv* shared = Perl_sharedsv_new(aTHX);
618 SV* obj = newSViv(PTR2IV(shared));
619 SHAREDSvEDIT(shared);
620 SHAREDSvGET(shared) = (SV*) newHV();
621 SHAREDSvRELEASE(shared);
627 STORE(self, key, value)
632 shared_sv* shared = INT2PTR(shared_sv*, SvIV(SvRV(self)));
637 char* ckey = SvPV(key, len);
638 SHAREDSvLOCK(shared);
640 shared_sv* target = Perl_sharedsv_find(aTHX_ SvRV(value));
642 Perl_croak(aTHX_ "You cannot assign a non shared reference to a shared hash");
644 SHAREDSvEDIT(shared);
645 value = newRV_noinc(newSViv(PTR2IV(target)));
646 SHAREDSvRELEASE(shared);
648 hentry_ = hv_fetch((HV*) SHAREDSvGET(shared), ckey, len, 0);
649 if(hentry_ && SvIV((*hentry_))) {
651 slot = INT2PTR(shared_sv*, SvIV(hentry));
652 if(SvROK(SHAREDSvGET(slot)))
653 Perl_sharedsv_thrcnt_dec(aTHX_ INT2PTR(shared_sv*, SvIV(SvRV(SHAREDSvGET(slot)))));
655 sv_setsv(SHAREDSvGET(slot), value);
656 SHAREDSvRELEASE(slot);
658 slot = Perl_sharedsv_new(aTHX);
659 SHAREDSvEDIT(shared);
660 SHAREDSvGET(slot) = newSVsv(value);
661 hentry = newSViv(PTR2IV(slot));
662 hv_store((HV*) SHAREDSvGET(shared), ckey,len , hentry, 0);
663 SHAREDSvRELEASE(shared);
665 if(SvROK(SHAREDSvGET(slot)))
666 Perl_sharedsv_thrcnt_inc(aTHX_ INT2PTR(shared_sv*, SvIV(SvRV(SHAREDSvGET(slot)))));
667 SHAREDSvUNLOCK(shared);
675 shared_sv* shared = INT2PTR(shared_sv*, SvIV(SvRV(self)));
681 char* ckey = SvPV(key, len);
682 SHAREDSvLOCK(shared);
683 hentry_ = hv_fetch((HV*) SHAREDSvGET(shared), ckey, len,0);
686 if(SvTYPE(hentry) == SVt_NULL) {
687 retval = &PL_sv_undef;
689 slot = INT2PTR(shared_sv*, SvIV(hentry));
690 if(SvROK(SHAREDSvGET(slot))) {
691 shared_sv* target = INT2PTR(shared_sv*, SvIV(SvRV(SHAREDSvGET(slot))));
692 retval = shared_sv_attach_sv(NULL, target);
694 retval = newSVsv(SHAREDSvGET(slot));
698 retval = &PL_sv_undef;
700 SHAREDSvUNLOCK(shared);
709 shared_sv* shared = INT2PTR(shared_sv*, SvIV(SvRV(self)));
712 SHAREDSvLOCK(shared);
713 Perl_hv_iterinit(PL_sharedsv_space, (HV*) SHAREDSvGET(shared));
714 entry = Perl_hv_iternext(PL_sharedsv_space, (HV*) SHAREDSvGET(shared));
716 slot = INT2PTR(shared_sv*, SvIV(Perl_hv_iterval(PL_sharedsv_space, (HV*) SHAREDSvGET(shared), entry)));
717 Perl_sharedsv_thrcnt_dec(aTHX_ slot);
718 entry = Perl_hv_iternext(PL_sharedsv_space,(HV*) SHAREDSvGET(shared));
720 SHAREDSvEDIT(shared);
721 hv_clear((HV*) SHAREDSvGET(shared));
722 SHAREDSvRELEASE(shared);
723 SHAREDSvUNLOCK(shared);
729 shared_sv* shared = INT2PTR(shared_sv*, SvIV(SvRV(self)));
733 SHAREDSvLOCK(shared);
734 Perl_hv_iterinit(PL_sharedsv_space, (HV*) SHAREDSvGET(shared));
735 entry = Perl_hv_iternext(PL_sharedsv_space, (HV*) SHAREDSvGET(shared));
737 key = Perl_hv_iterkey(PL_sharedsv_space, entry,&len);
738 RETVAL = newSVpv(key, len);
740 RETVAL = &PL_sv_undef;
742 SHAREDSvUNLOCK(shared);
748 NEXTKEY(self, oldkey)
752 shared_sv* shared = INT2PTR(shared_sv*, SvIV(SvRV(self)));
756 SHAREDSvLOCK(shared);
757 entry = Perl_hv_iternext(PL_sharedsv_space, (HV*) SHAREDSvGET(shared));
759 key = Perl_hv_iterkey(PL_sharedsv_space, entry,&len);
760 RETVAL = newSVpv(key, len);
762 RETVAL = &PL_sv_undef;
764 SHAREDSvUNLOCK(shared);
774 shared_sv* shared = INT2PTR(shared_sv*, SvIV(SvRV(self)));
776 char* ckey = SvPV(key, len);
777 SHAREDSvLOCK(shared);
778 if(hv_exists((HV*)SHAREDSvGET(shared), ckey, len)) {
783 SHAREDSvUNLOCK(shared);
792 shared_sv* shared = INT2PTR(shared_sv*, SvIV(SvRV(self)));
795 char* ckey = SvPV(key, len);
797 SHAREDSvLOCK(shared);
798 SHAREDSvEDIT(shared);
799 tmp = hv_delete((HV*) SHAREDSvGET(shared), ckey, len,0);
800 SHAREDSvRELEASE(shared);
802 slot = INT2PTR(shared_sv*, SvIV(tmp));
803 if(SvROK(SHAREDSvGET(slot))) {
804 shared_sv* target = INT2PTR(shared_sv*, SvIV(SvRV(SHAREDSvGET(slot))));
805 RETVAL = shared_sv_attach_sv(NULL, target);
807 RETVAL = newSVsv(SHAREDSvGET(slot));
809 Perl_sharedsv_thrcnt_dec(aTHX_ slot);
811 RETVAL = &PL_sv_undef;
813 SHAREDSvUNLOCK(shared);