7 SV* shared_sv_attach_sv (SV* sv, shared_sv* shared) {
8 HV* shared_hv = get_hv("threads::shared::shared", FALSE);
9 SV* id = newSViv((IV)shared);
10 STRLEN length = sv_len(id);
12 SV** tiedobject_ = hv_fetch(shared_hv, SvPV(id,length), length, 0);
14 tiedobject = (*tiedobject_);
17 SvRV(sv) = SvRV(tiedobject);
19 sv = newRV(SvRV(tiedobject));
28 int shared_sv_fetch_mg (pTHX_ SV* sv, MAGIC *mg) {
29 shared_sv* shared = (shared_sv*) SvIV(mg->mg_obj);
31 if(mg->mg_private != shared->index) {
32 if(SvROK(SHAREDSvGET(shared))) {
33 shared_sv* target = (shared_sv*) SvIV(SvRV(SHAREDSvGET(shared)));
34 shared_sv_attach_sv(sv, target);
36 sv_setsv(sv, SHAREDSvGET(shared));
38 mg->mg_private = shared->index;
40 SHAREDSvUNLOCK(shared);
45 int shared_sv_store_mg (pTHX_ SV* sv, MAGIC *mg) {
46 shared_sv* shared = (shared_sv*) SvIV(mg->mg_obj);
48 if(SvROK(SHAREDSvGET(shared)))
49 Perl_sharedsv_thrcnt_dec(aTHX_ (shared_sv*) SvIV(SvRV(SHAREDSvGET(shared))));
51 shared_sv* target = Perl_sharedsv_find(aTHX_ SvRV(sv));
53 sv_setsv(sv,SHAREDSvGET(shared));
54 SHAREDSvUNLOCK(shared);
55 Perl_croak(aTHX_ "You cannot assign a non shared reference to a shared scalar");
58 Perl_sv_free(PL_sharedsv_space,SHAREDSvGET(shared));
59 SHAREDSvGET(shared) = newRV_noinc(newSViv((IV)target));
62 sv_setsv(SHAREDSvGET(shared), sv);
65 mg->mg_private = shared->index;
66 SHAREDSvRELEASE(shared);
67 if(SvROK(SHAREDSvGET(shared)))
68 Perl_sharedsv_thrcnt_inc(aTHX_ (shared_sv*) SvIV(SvRV(SHAREDSvGET(shared))));
69 SHAREDSvUNLOCK(shared);
73 int shared_sv_destroy_mg (pTHX_ SV* sv, MAGIC *mg) {
74 shared_sv* shared = (shared_sv*) SvIV(mg->mg_obj);
77 Perl_sharedsv_thrcnt_dec(aTHX_ shared);
80 MGVTBL svtable = {MEMBER_TO_FPTR(shared_sv_fetch_mg),
81 MEMBER_TO_FPTR(shared_sv_store_mg),
84 MEMBER_TO_FPTR(shared_sv_destroy_mg)
87 MODULE = threads::shared PACKAGE = threads::shared
97 RETVAL = newSViv(SvIV(SvRV(ref)));
109 shared = Perl_sharedsv_find(aTHX, ref);
111 croak("thrcnt can only be used on shared values");
112 SHAREDSvLOCK(shared);
113 RETVAL = newSViv(SvREFCNT(SHAREDSvGET(shared)));
114 SHAREDSvUNLOCK(shared);
126 shared = Perl_sharedsv_find(aTHX, ref);
128 croak("thrcnt can only be used on shared values");
129 Perl_sharedsv_thrcnt_inc(aTHX_ shared);
135 shared_sv* shared = (shared_sv*) SvIV(ref);
137 croak("thrcnt can only be used on shared values");
138 Perl_sharedsv_thrcnt_dec(aTHX_ shared);
141 MODULE = threads::shared PACKAGE = threads::shared::sv
148 shared_sv* shared = Perl_sharedsv_new(aTHX);
150 SV* obj = newSViv((IV)shared);
151 SHAREDSvEDIT(shared);
152 SHAREDSvGET(shared) = newSVsv(value);
153 SHAREDSvRELEASE(shared);
154 sv_magic(value, 0, PERL_MAGIC_ext, "threads::shared", 16);
155 shared_magic = mg_find(value, PERL_MAGIC_ext);
156 shared_magic->mg_virtual = &svtable;
157 shared_magic->mg_obj = newSViv((IV)shared);
158 shared_magic->mg_flags |= MGf_REFCOUNTED;
159 shared_magic->mg_private = 0;
166 MODULE = threads::shared PACKAGE = threads::shared::av
173 shared_sv* shared = Perl_sharedsv_new(aTHX);
174 SV* obj = newSViv((IV)shared);
175 SHAREDSvEDIT(shared);
176 SHAREDSvGET(shared) = (SV*) newAV();
177 SHAREDSvRELEASE(shared);
183 STORE(self, index, value)
188 shared_sv* shared = (shared_sv*) SvIV(SvRV(self));
192 SHAREDSvLOCK(shared);
193 aentry_ = av_fetch((AV*) SHAREDSvGET(shared), SvIV(index), 0);
194 if(aentry_ && SvIV((*aentry_))) {
196 slot = (shared_sv*) SvIV(aentry);
197 if(SvROK(SHAREDSvGET(slot)))
198 Perl_sharedsv_thrcnt_dec(aTHX_ (shared_sv*) SvIV(SvRV(SHAREDSvGET(slot))));
200 sv_setsv(SHAREDSvGET(slot), value);
201 SHAREDSvRELEASE(slot);
203 slot = Perl_sharedsv_new(aTHX);
204 SHAREDSvEDIT(shared);
205 SHAREDSvGET(slot) = newSVsv(value);
206 aentry = newSViv((IV)slot);
207 av_store((AV*) SHAREDSvGET(shared), SvIV(index), aentry);
208 SHAREDSvRELEASE(shared);
210 SHAREDSvUNLOCK(shared);
217 shared_sv* shared = (shared_sv*) SvIV(SvRV(self));
222 SHAREDSvLOCK(shared);
223 aentry_ = av_fetch((AV*) SHAREDSvGET(shared), SvIV(index),0);
226 if(SvTYPE(aentry) == SVt_NULL) {
227 retval = &PL_sv_undef;
229 slot = (shared_sv*) SvIV(aentry);
230 retval = newSVsv(SHAREDSvGET(slot));
233 retval = &PL_sv_undef;
235 SHAREDSvUNLOCK(shared);
244 shared_sv* shared = (shared_sv*) SvIV(SvRV(self));
246 SHAREDSvLOCK(shared);
247 for(i = 1; i < items; i++) {
248 shared_sv* slot = Perl_sharedsv_new(aTHX);
251 SHAREDSvGET(slot) = newSVsv(tmp);
252 av_push((AV*) SHAREDSvGET(shared), newSViv((IV)slot));
253 SHAREDSvRELEASE(slot);
255 SHAREDSvUNLOCK(shared);
261 shared_sv* shared = (shared_sv*) SvIV(SvRV(self));
263 SHAREDSvLOCK(shared);
264 SHAREDSvEDIT(shared);
265 av_unshift((AV*)SHAREDSvGET(shared), items - 1);
266 SHAREDSvRELEASE(shared);
267 for(i = 1; i < items; i++) {
268 shared_sv* slot = Perl_sharedsv_new(aTHX);
271 SHAREDSvGET(slot) = newSVsv(tmp);
272 av_store((AV*) SHAREDSvGET(shared), i - 1, newSViv((IV)slot));
273 SHAREDSvRELEASE(slot);
275 SHAREDSvUNLOCK(shared);
281 shared_sv* shared = (shared_sv*) SvIV(SvRV(self));
284 SHAREDSvLOCK(shared);
285 SHAREDSvEDIT(shared);
286 retval = av_pop((AV*)SHAREDSvGET(shared));
287 SHAREDSvRELEASE(shared);
288 if(retval && SvIV(retval)) {
289 slot = (shared_sv*) SvIV(retval);
290 retval = newSVsv(SHAREDSvGET(slot));
291 Perl_sharedsv_thrcnt_dec(aTHX_ slot);
293 retval = &PL_sv_undef;
295 SHAREDSvUNLOCK(shared);
305 shared_sv* shared = (shared_sv*) SvIV(SvRV(self));
308 SHAREDSvLOCK(shared);
309 SHAREDSvEDIT(shared);
310 retval = av_shift((AV*)SHAREDSvGET(shared));
311 SHAREDSvRELEASE(shared);
312 if(retval && SvIV(retval)) {
313 slot = (shared_sv*) SvIV(retval);
314 retval = newSVsv(SHAREDSvGET(slot));
315 Perl_sharedsv_thrcnt_dec(aTHX_ slot);
317 retval = &PL_sv_undef;
319 SHAREDSvUNLOCK(shared);
328 shared_sv* shared = (shared_sv*) SvIV(SvRV(self));
332 SHAREDSvLOCK(shared);
333 svp = AvARRAY((AV*)SHAREDSvGET(shared));
334 i = AvFILLp((AV*)SHAREDSvGET(shared));
337 Perl_sharedsv_thrcnt_dec(aTHX_ (shared_sv*) SvIV(svp[i]));
341 SHAREDSvEDIT(shared);
342 av_clear((AV*)SHAREDSvGET(shared));
343 SHAREDSvRELEASE(shared);
344 SHAREDSvUNLOCK(shared);
351 shared_sv* shared = (shared_sv*) SvIV(SvRV(self));
352 SHAREDSvEDIT(shared);
353 av_extend((AV*)SHAREDSvGET(shared), (I32) SvIV(count));
354 SHAREDSvRELEASE(shared);
364 shared_sv* shared = (shared_sv*) SvIV(SvRV(self));
366 SHAREDSvLOCK(shared);
367 exists = av_exists((AV*) SHAREDSvGET(shared), (I32) SvIV(index));
373 SHAREDSvUNLOCK(shared);
376 STORESIZE(self,count)
380 shared_sv* shared = (shared_sv*) SvIV(SvRV(self));
381 SHAREDSvEDIT(shared);
382 av_fill((AV*) SHAREDSvGET(shared), (I32) SvIV(count));
383 SHAREDSvRELEASE(shared);
389 shared_sv* shared = (shared_sv*) SvIV(SvRV(self));
390 SHAREDSvLOCK(shared);
391 RETVAL = newSViv(av_len((AV*) SHAREDSvGET(shared)) + 1);
392 SHAREDSvUNLOCK(shared);
401 shared_sv* shared = (shared_sv*) SvIV(SvRV(self));
403 SHAREDSvLOCK(shared);
404 if(av_exists((AV*) SHAREDSvGET(shared), (I32) SvIV(index))) {
406 SHAREDSvEDIT(shared);
407 tmp = av_delete((AV*)SHAREDSvGET(shared), (I32) SvIV(index),0);
408 SHAREDSvRELEASE(shared);
410 slot = (shared_sv*) SvIV(tmp);
411 RETVAL = newSVsv(SHAREDSvGET(slot));
412 Perl_sharedsv_thrcnt_dec(aTHX_ slot);
414 RETVAL = &PL_sv_undef;
417 RETVAL = &PL_sv_undef;
419 SHAREDSvUNLOCK(shared);
424 SPLICE(self, offset, length, ...)
429 croak("Splice is not implmented for shared arrays");
431 MODULE = threads::shared PACKAGE = threads::shared::hv
438 shared_sv* shared = Perl_sharedsv_new(aTHX);
439 SV* obj = newSViv((IV)shared);
440 SHAREDSvEDIT(shared);
441 SHAREDSvGET(shared) = (SV*) newHV();
442 SHAREDSvRELEASE(shared);
448 STORE(self, key, value)
453 shared_sv* shared = (shared_sv*) SvIV(SvRV(self));
458 char* ckey = SvPV(key, len);
460 shared_sv* target = Perl_sharedsv_find(aTHX_ SvRV(value));
462 Perl_croak(aTHX_ "You cannot assign a non shared reference to a shared hash");
464 value = newRV_noinc(newSViv((IV)target));
466 SHAREDSvLOCK(shared);
467 hentry_ = hv_fetch((HV*) SHAREDSvGET(shared), ckey, len, 0);
468 if(hentry_ && SvIV((*hentry_))) {
470 slot = (shared_sv*) SvIV(hentry);
471 if(SvROK(SHAREDSvGET(slot)))
472 Perl_sharedsv_thrcnt_dec(aTHX_ (shared_sv*) SvIV(SvRV(SHAREDSvGET(slot))));
474 sv_setsv(SHAREDSvGET(slot), value);
475 SHAREDSvRELEASE(slot);
477 slot = Perl_sharedsv_new(aTHX);
478 SHAREDSvEDIT(shared);
479 SHAREDSvGET(slot) = newSVsv(value);
480 hentry = newSViv((IV)slot);
481 hv_store((HV*) SHAREDSvGET(shared), ckey,len , hentry, 0);
482 SHAREDSvRELEASE(shared);
484 if(SvROK(SHAREDSvGET(slot)))
485 Perl_sharedsv_thrcnt_inc(aTHX_ (shared_sv*) SvIV(SvRV(SHAREDSvGET(slot))));
486 SHAREDSvUNLOCK(shared);
494 shared_sv* shared = (shared_sv*) SvIV(SvRV(self));
500 char* ckey = SvPV(key, len);
501 SHAREDSvLOCK(shared);
502 hentry_ = hv_fetch((HV*) SHAREDSvGET(shared), ckey, len,0);
505 if(SvTYPE(hentry) == SVt_NULL) {
506 retval = &PL_sv_undef;
508 slot = (shared_sv*) SvIV(hentry);
509 if(SvROK(SHAREDSvGET(slot))) {
510 shared_sv* target = (shared_sv*) SvIV(SvRV(SHAREDSvGET(slot)));
511 retval = shared_sv_attach_sv(NULL, target);
513 retval = newSVsv(SHAREDSvGET(slot));
517 retval = &PL_sv_undef;
519 SHAREDSvUNLOCK(shared);
528 shared_sv* shared = (shared_sv*) SvIV(SvRV(self));
531 SHAREDSvLOCK(shared);
532 Perl_hv_iterinit(PL_sharedsv_space, (HV*) SHAREDSvGET(shared));
533 entry = Perl_hv_iternext(PL_sharedsv_space, (HV*) SHAREDSvGET(shared));
535 slot = (shared_sv*) SvIV(Perl_hv_iterval(PL_sharedsv_space, (HV*) SHAREDSvGET(shared), entry));
536 Perl_sharedsv_thrcnt_dec(aTHX_ slot);
537 entry = Perl_hv_iternext(PL_sharedsv_space,(HV*) SHAREDSvGET(shared));
539 SHAREDSvEDIT(shared);
540 hv_clear((HV*) SHAREDSvGET(shared));
541 SHAREDSvRELEASE(shared);
542 SHAREDSvUNLOCK(shared);
548 shared_sv* shared = (shared_sv*) SvIV(SvRV(self));
552 SHAREDSvLOCK(shared);
553 Perl_hv_iterinit(PL_sharedsv_space, (HV*) SHAREDSvGET(shared));
554 entry = Perl_hv_iternext(PL_sharedsv_space, (HV*) SHAREDSvGET(shared));
556 key = Perl_hv_iterkey(PL_sharedsv_space, entry,&len);
557 RETVAL = newSVpv(key, len);
559 RETVAL = &PL_sv_undef;
561 SHAREDSvUNLOCK(shared);
567 NEXTKEY(self, oldkey)
571 shared_sv* shared = (shared_sv*) SvIV(SvRV(self));
575 SHAREDSvLOCK(shared);
576 entry = Perl_hv_iternext(PL_sharedsv_space, (HV*) SHAREDSvGET(shared));
578 key = Perl_hv_iterkey(PL_sharedsv_space, entry,&len);
579 RETVAL = newSVpv(key, len);
581 RETVAL = &PL_sv_undef;
583 SHAREDSvUNLOCK(shared);
593 shared_sv* shared = (shared_sv*) SvIV(SvRV(self));
595 char* ckey = SvPV(key, len);
596 SHAREDSvLOCK(shared);
597 if(hv_exists((HV*)SHAREDSvGET(shared), ckey, len)) {
602 SHAREDSvUNLOCK(shared);
611 shared_sv* shared = (shared_sv*) SvIV(SvRV(self));
614 char* ckey = SvPV(key, len);
616 SHAREDSvLOCK(shared);
617 SHAREDSvEDIT(shared);
618 tmp = hv_delete((HV*) SHAREDSvGET(shared), ckey, len,0);
619 SHAREDSvRELEASE(shared);
621 slot = (shared_sv*) SvIV(tmp);
622 if(SvROK(SHAREDSvGET(slot))) {
623 shared_sv* target = (shared_sv*) SvIV(SvRV(SHAREDSvGET(slot)));
624 RETVAL = shared_sv_attach_sv(NULL, target);
626 RETVAL = newSVsv(SHAREDSvGET(slot));
628 Perl_sharedsv_thrcnt_dec(aTHX_ slot);
630 RETVAL = &PL_sv_undef;
632 SHAREDSvUNLOCK(shared);