projects / p5sagit/p5-mst-13.2.git / blame
? search:
summary | shortlog | log | commit | commitdiff | tree
blob | history | HEAD
Ugly fix to not die when a thread creator is holding locks.
[p5sagit/p5-mst-13.2.git] / ext / threads / shared / shared.xs
CommitLineData
b050c948 1
2#include "EXTERN.h"
3#include "perl.h"
4#include "XSUB.h"
5
409b1fd3 6MGVTBL svtable;
b050c948 7
0d76d117 8SV* shared_sv_attach_sv (SV* sv, shared_sv* shared) {
b050c948 9 HV* shared_hv = get_hv("threads::shared::shared", FALSE);
10 SV* id = newSViv((IV)shared);
11 STRLEN length = sv_len(id);
12 SV* tiedobject;
13 SV** tiedobject_ = hv_fetch(shared_hv, SvPV(id,length), length, 0);
14 if(tiedobject_) {
15 tiedobject = (*tiedobject_);
0d76d117 16 if(sv) {
17 SvROK_on(sv);
18 SvRV(sv) = SvRV(tiedobject);
19 } else {
20 sv = newRV(SvRV(tiedobject));
21 }
b050c948 22 } else {
409b1fd3 23 switch(SvTYPE(SHAREDSvGET(shared))) {
938785a2 24 case SVt_PVAV: {
25 SV* weakref;
26 SV* obj_ref = newSViv(0);
27 SV* obj = newSVrv(obj_ref,"threads::shared::av");
28 AV* hv = newAV();
29 sv_setiv(obj,(IV)shared);
30 weakref = newRV((SV*)hv);
31 sv = newRV_noinc((SV*)hv);
32 sv_rvweaken(weakref);
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);
36 }
37 break;
38 case SVt_PVHV: {
39 SV* weakref;
40 SV* obj_ref = newSViv(0);
41 SV* obj = newSVrv(obj_ref,"threads::shared::hv");
42 HV* hv = newHV();
43 sv_setiv(obj,(IV)shared);
44 weakref = newRV((SV*)hv);
45 sv = newRV_noinc((SV*)hv);
46 sv_rvweaken(weakref);
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);
50 }
51 break;
409b1fd3 52 default: {
53 MAGIC* shared_magic;
54 SV* value = newSVsv(SHAREDSvGET(shared));
55 SV* obj = newSViv((IV)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((IV)shared);
60 shared_magic->mg_flags |= MGf_REFCOUNTED;
61 shared_magic->mg_private = 0;
62 SvMAGICAL_on(value);
63 sv = newRV_noinc(value);
64 value = newRV(value);
65 sv_rvweaken(value);
66 hv_store(shared_hv, SvPV(id,length),length, value, 0);
67 Perl_sharedsv_thrcnt_inc(aTHX_ shared);
68 }
69
70 }
b050c948 71 }
0d76d117 72 return sv;
b050c948 73}
74
75
76int shared_sv_fetch_mg (pTHX_ SV* sv, MAGIC *mg) {
77 shared_sv* shared = (shared_sv*) SvIV(mg->mg_obj);
78 SHAREDSvLOCK(shared);
55fc11ad 79 if(mg->mg_private != shared->index) {
80 if(SvROK(SHAREDSvGET(shared))) {
81 shared_sv* target = (shared_sv*) SvIV(SvRV(SHAREDSvGET(shared)));
82 shared_sv_attach_sv(sv, target);
83 } else {
84 sv_setsv(sv, SHAREDSvGET(shared));
85 }
86 mg->mg_private = shared->index;
b050c948 87 }
88 SHAREDSvUNLOCK(shared);
89
90 return 0;
91}
92
93int shared_sv_store_mg (pTHX_ SV* sv, MAGIC *mg) {
94 shared_sv* shared = (shared_sv*) SvIV(mg->mg_obj);
95 SHAREDSvLOCK(shared);
96 if(SvROK(SHAREDSvGET(shared)))
97 Perl_sharedsv_thrcnt_dec(aTHX_ (shared_sv*) SvIV(SvRV(SHAREDSvGET(shared))));
b050c948 98 if(SvROK(sv)) {
99 shared_sv* target = Perl_sharedsv_find(aTHX_ SvRV(sv));
100 if(!target) {
b050c948 101 sv_setsv(sv,SHAREDSvGET(shared));
102 SHAREDSvUNLOCK(shared);
103 Perl_croak(aTHX_ "You cannot assign a non shared reference to a shared scalar");
104 }
f70d29d4 105 SHAREDSvEDIT(shared);
b050c948 106 Perl_sv_free(PL_sharedsv_space,SHAREDSvGET(shared));
107 SHAREDSvGET(shared) = newRV_noinc(newSViv((IV)target));
b050c948 108 } else {
f70d29d4 109 SHAREDSvEDIT(shared);
110 sv_setsv(SHAREDSvGET(shared), sv);
b050c948 111 }
55fc11ad 112 shared->index++;
113 mg->mg_private = shared->index;
b050c948 114 SHAREDSvRELEASE(shared);
115 if(SvROK(SHAREDSvGET(shared)))
116 Perl_sharedsv_thrcnt_inc(aTHX_ (shared_sv*) SvIV(SvRV(SHAREDSvGET(shared))));
117 SHAREDSvUNLOCK(shared);
118 return 0;
119}
120
121int shared_sv_destroy_mg (pTHX_ SV* sv, MAGIC *mg) {
122 shared_sv* shared = (shared_sv*) SvIV(mg->mg_obj);
123 if(!shared)
124 return 0;
409b1fd3 125 {
126 HV* shared_hv = get_hv("threads::shared::shared", FALSE);
127 SV* id = newSViv((IV)shared);
128 STRLEN length = sv_len(id);
129 hv_delete(shared_hv, SvPV(id,length), length,0);
130 }
b050c948 131 Perl_sharedsv_thrcnt_dec(aTHX_ shared);
132}
133
134MGVTBL svtable = {MEMBER_TO_FPTR(shared_sv_fetch_mg),
135 MEMBER_TO_FPTR(shared_sv_store_mg),
136 0,
137 0,
138 MEMBER_TO_FPTR(shared_sv_destroy_mg)
139};
140
141MODULE = threads::shared PACKAGE = threads::shared
142
143
ce127893 144PROTOTYPES: ENABLE
b050c948 145
146
147SV*
148ptr(ref)
149 SV* ref
150 CODE:
151 RETVAL = newSViv(SvIV(SvRV(ref)));
152 OUTPUT:
153 RETVAL
154
155
156SV*
157_thrcnt(ref)
158 SV* ref
159 CODE:
866fba46 160 shared_sv* shared;
161 if(SvROK(ref))
162 ref = SvRV(ref);
163 shared = Perl_sharedsv_find(aTHX, ref);
b050c948 164 if(!shared)
165 croak("thrcnt can only be used on shared values");
166 SHAREDSvLOCK(shared);
167 RETVAL = newSViv(SvREFCNT(SHAREDSvGET(shared)));
168 SHAREDSvUNLOCK(shared);
169 OUTPUT:
170 RETVAL
171
172
173void
cd8c9bf8 174thrcnt_inc(ref,perl)
b050c948 175 SV* ref
cd8c9bf8 176 SV* perl
b050c948 177 CODE:
178 shared_sv* shared;
cd8c9bf8 179 PerlInterpreter* origperl = (PerlInterpreter*) SvIV(perl);
180 PerlInterpreter* oldperl = PERL_GET_CONTEXT;
b050c948 181 if(SvROK(ref))
182 ref = SvRV(ref);
183 shared = Perl_sharedsv_find(aTHX, ref);
184 if(!shared)
185 croak("thrcnt can only be used on shared values");
cd8c9bf8 186 PERL_SET_CONTEXT(origperl);
b050c948 187 Perl_sharedsv_thrcnt_inc(aTHX_ shared);
cd8c9bf8 188 PERL_SET_CONTEXT(oldperl);
b050c948 189
866fba46 190void
191_thrcnt_dec(ref)
192 SV* ref
193 CODE:
194 shared_sv* shared = (shared_sv*) SvIV(ref);
195 if(!shared)
196 croak("thrcnt can only be used on shared values");
197 Perl_sharedsv_thrcnt_dec(aTHX_ shared);
198
6f942b98 199void
200unlock_enabled(ref)
201 SV* ref
ce127893 202 PROTOTYPE: \[$@%]
6f942b98 203 CODE:
204 shared_sv* shared;
205 if(SvROK(ref))
206 ref = SvRV(ref);
207 shared = Perl_sharedsv_find(aTHX, ref);
208 if(!shared)
209 croak("unlock can only be used on shared values");
210 SHAREDSvUNLOCK(shared);
211
212void
213lock_enabled(ref)
214 SV* ref
6f942b98 215 CODE:
216 shared_sv* shared;
217 if(SvROK(ref))
218 ref = SvRV(ref);
219 shared = Perl_sharedsv_find(aTHX, ref);
220 if(!shared)
221 croak("lock can only be used on shared values");
222 SHAREDSvLOCK(shared);
223
224
225void
226cond_wait_enabled(ref)
227 SV* ref
ce127893 228 PROTOTYPE: \[$@%]
6f942b98 229 CODE:
230 shared_sv* shared;
231 int locks;
232 if(SvROK(ref))
233 ref = SvRV(ref);
234 shared = Perl_sharedsv_find(aTHX_ ref);
235 if(!shared)
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;
a6b94e59 245 MUTEX_UNLOCK(&shared->mutex);
6f942b98 246
247void cond_signal_enabled(ref)
248 SV* ref
ce127893 249 PROTOTYPE: \[$@%]
6f942b98 250 CODE:
251 shared_sv* shared;
252 if(SvROK(ref))
253 ref = SvRV(ref);
254 shared = Perl_sharedsv_find(aTHX_ ref);
255 if(!shared)
256 croak("cond_signal can only be used on shared values");
257 COND_SIGNAL(&shared->user_cond);
258
259
260void cond_broadcast_enabled(ref)
261 SV* ref
ce127893 262 PROTOTYPE: \[$@%]
6f942b98 263 CODE:
264 shared_sv* shared;
265 if(SvROK(ref))
266 ref = SvRV(ref);
267 shared = Perl_sharedsv_find(aTHX_ ref);
268 if(!shared)
269 croak("cond_broadcast can only be used on shared values");
270 COND_BROADCAST(&shared->user_cond);
b050c948 271
272MODULE = threads::shared PACKAGE = threads::shared::sv
273
274SV*
275new(class, value)
276 SV* class
277 SV* value
278 CODE:
279 shared_sv* shared = Perl_sharedsv_new(aTHX);
280 MAGIC* shared_magic;
281 SV* obj = newSViv((IV)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((IV)shared);
289 shared_magic->mg_flags |= MGf_REFCOUNTED;
55fc11ad 290 shared_magic->mg_private = 0;
b050c948 291 SvMAGICAL_on(value);
292 RETVAL = obj;
293 OUTPUT:
294 RETVAL
295
296
aaf3876d 297MODULE = threads::shared PACKAGE = threads::shared::av
298
299SV*
300new(class, value)
301 SV* class
302 SV* value
303 CODE:
304 shared_sv* shared = Perl_sharedsv_new(aTHX);
305 SV* obj = newSViv((IV)shared);
306 SHAREDSvEDIT(shared);
307 SHAREDSvGET(shared) = (SV*) newAV();
308 SHAREDSvRELEASE(shared);
309 RETVAL = obj;
310 OUTPUT:
311 RETVAL
312
313void
314STORE(self, index, value)
315 SV* self
316 SV* index
317 SV* value
318 CODE:
319 shared_sv* shared = (shared_sv*) SvIV(SvRV(self));
320 shared_sv* slot;
321 SV* aentry;
322 SV** aentry_;
79a24c1c 323 if(SvROK(value)) {
324 shared_sv* target = Perl_sharedsv_find(aTHX_ SvRV(value));
325 if(!target) {
326 Perl_croak(aTHX_ "You cannot assign a non shared reference to an shared array");
327 }
328 value = newRV_noinc(newSViv((IV)target));
329 }
aaf3876d 330 SHAREDSvLOCK(shared);
331 aentry_ = av_fetch((AV*) SHAREDSvGET(shared), SvIV(index), 0);
332 if(aentry_ && SvIV((*aentry_))) {
333 aentry = (*aentry_);
334 slot = (shared_sv*) SvIV(aentry);
335 if(SvROK(SHAREDSvGET(slot)))
336 Perl_sharedsv_thrcnt_dec(aTHX_ (shared_sv*) SvIV(SvRV(SHAREDSvGET(slot))));
337 SHAREDSvEDIT(slot);
338 sv_setsv(SHAREDSvGET(slot), value);
339 SHAREDSvRELEASE(slot);
340 } else {
341 slot = Perl_sharedsv_new(aTHX);
342 SHAREDSvEDIT(shared);
343 SHAREDSvGET(slot) = newSVsv(value);
344 aentry = newSViv((IV)slot);
345 av_store((AV*) SHAREDSvGET(shared), SvIV(index), aentry);
346 SHAREDSvRELEASE(shared);
347 }
79a24c1c 348 if(SvROK(SHAREDSvGET(slot)))
349 Perl_sharedsv_thrcnt_inc(aTHX_ (shared_sv*) SvIV(SvRV(SHAREDSvGET(slot))));
350
aaf3876d 351 SHAREDSvUNLOCK(shared);
352
353SV*
354FETCH(self, index)
355 SV* self
356 SV* index
357 CODE:
358 shared_sv* shared = (shared_sv*) SvIV(SvRV(self));
359 shared_sv* slot;
360 SV* aentry;
361 SV** aentry_;
362 SV* retval;
363 SHAREDSvLOCK(shared);
364 aentry_ = av_fetch((AV*) SHAREDSvGET(shared), SvIV(index),0);
365 if(aentry_) {
366 aentry = (*aentry_);
367 if(SvTYPE(aentry) == SVt_NULL) {
368 retval = &PL_sv_undef;
369 } else {
370 slot = (shared_sv*) SvIV(aentry);
79a24c1c 371 if(SvROK(SHAREDSvGET(slot))) {
372 shared_sv* target = (shared_sv*) SvIV(SvRV(SHAREDSvGET(slot)));
373 retval = shared_sv_attach_sv(NULL,target);
374 } else {
375 retval = newSVsv(SHAREDSvGET(slot));
376 }
aaf3876d 377 }
378 } else {
379 retval = &PL_sv_undef;
380 }
381 SHAREDSvUNLOCK(shared);
382 RETVAL = retval;
383 OUTPUT:
384 RETVAL
385
386void
387PUSH(self, ...)
388 SV* self
389 CODE:
390 shared_sv* shared = (shared_sv*) SvIV(SvRV(self));
391 int i;
392 SHAREDSvLOCK(shared);
393 for(i = 1; i < items; i++) {
394 shared_sv* slot = Perl_sharedsv_new(aTHX);
395 SV* tmp = ST(i);
79a24c1c 396 if(SvROK(tmp)) {
397 shared_sv* target = Perl_sharedsv_find(aTHX_ SvRV(tmp));
398 if(!target) {
399 Perl_croak(aTHX_ "You cannot assign a non shared reference to an shared array");
400 }
401 tmp = newRV_noinc(newSViv((IV)target));
402 }
aaf3876d 403 SHAREDSvEDIT(slot);
404 SHAREDSvGET(slot) = newSVsv(tmp);
405 av_push((AV*) SHAREDSvGET(shared), newSViv((IV)slot));
406 SHAREDSvRELEASE(slot);
79a24c1c 407 if(SvROK(SHAREDSvGET(slot)))
408 Perl_sharedsv_thrcnt_inc(aTHX_ (shared_sv*) SvIV(SvRV(SHAREDSvGET(slot))));
aaf3876d 409 }
410 SHAREDSvUNLOCK(shared);
411
412void
413UNSHIFT(self, ...)
414 SV* self
415 CODE:
416 shared_sv* shared = (shared_sv*) SvIV(SvRV(self));
417 int i;
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);
424 SV* tmp = ST(i);
79a24c1c 425 if(SvROK(tmp)) {
426 shared_sv* target = Perl_sharedsv_find(aTHX_ SvRV(tmp));
427 if(!target) {
428 Perl_croak(aTHX_ "You cannot assign a non shared reference to an shared array");
429 }
430 tmp = newRV_noinc(newSViv((IV)target));
431 }
aaf3876d 432 SHAREDSvEDIT(slot);
433 SHAREDSvGET(slot) = newSVsv(tmp);
434 av_store((AV*) SHAREDSvGET(shared), i - 1, newSViv((IV)slot));
435 SHAREDSvRELEASE(slot);
79a24c1c 436 if(SvROK(SHAREDSvGET(slot)))
437 Perl_sharedsv_thrcnt_inc(aTHX_ (shared_sv*) SvIV(SvRV(SHAREDSvGET(slot))));
aaf3876d 438 }
439 SHAREDSvUNLOCK(shared);
440
441SV*
442POP(self)
443 SV* self
444 CODE:
445 shared_sv* shared = (shared_sv*) SvIV(SvRV(self));
446 shared_sv* slot;
447 SV* retval;
448 SHAREDSvLOCK(shared);
449 SHAREDSvEDIT(shared);
450 retval = av_pop((AV*)SHAREDSvGET(shared));
451 SHAREDSvRELEASE(shared);
452 if(retval && SvIV(retval)) {
453 slot = (shared_sv*) SvIV(retval);
79a24c1c 454 if(SvROK(SHAREDSvGET(slot))) {
455 shared_sv* target = (shared_sv*) SvIV(SvRV(SHAREDSvGET(slot)));
456 retval = shared_sv_attach_sv(NULL,target);
457 } else {
458 retval = newSVsv(SHAREDSvGET(slot));
459 }
aaf3876d 460 Perl_sharedsv_thrcnt_dec(aTHX_ slot);
461 } else {
462 retval = &PL_sv_undef;
463 }
464 SHAREDSvUNLOCK(shared);
465 RETVAL = retval;
466 OUTPUT:
467 RETVAL
468
469
470SV*
471SHIFT(self)
472 SV* self
473 CODE:
474 shared_sv* shared = (shared_sv*) SvIV(SvRV(self));
475 shared_sv* slot;
476 SV* retval;
477 SHAREDSvLOCK(shared);
478 SHAREDSvEDIT(shared);
479 retval = av_shift((AV*)SHAREDSvGET(shared));
480 SHAREDSvRELEASE(shared);
481 if(retval && SvIV(retval)) {
482 slot = (shared_sv*) SvIV(retval);
79a24c1c 483 if(SvROK(SHAREDSvGET(slot))) {
484 shared_sv* target = (shared_sv*) SvIV(SvRV(SHAREDSvGET(slot)));
485 retval = shared_sv_attach_sv(NULL,target);
486 } else {
487 retval = newSVsv(SHAREDSvGET(slot));
488 }
aaf3876d 489 Perl_sharedsv_thrcnt_dec(aTHX_ slot);
490 } else {
491 retval = &PL_sv_undef;
492 }
493 SHAREDSvUNLOCK(shared);
494 RETVAL = retval;
495 OUTPUT:
496 RETVAL
497
498void
499CLEAR(self)
500 SV* self
501 CODE:
502 shared_sv* shared = (shared_sv*) SvIV(SvRV(self));
503 shared_sv* slot;
504 SV** svp;
505 I32 i;
506 SHAREDSvLOCK(shared);
507 svp = AvARRAY((AV*)SHAREDSvGET(shared));
508 i = AvFILLp((AV*)SHAREDSvGET(shared));
509 while ( i >= 0) {
510 if(SvIV(svp[i])) {
511 Perl_sharedsv_thrcnt_dec(aTHX_ (shared_sv*) SvIV(svp[i]));
512 }
513 i--;
514 }
515 SHAREDSvEDIT(shared);
516 av_clear((AV*)SHAREDSvGET(shared));
517 SHAREDSvRELEASE(shared);
518 SHAREDSvUNLOCK(shared);
519
520void
521EXTEND(self, count)
522 SV* self
523 SV* count
524 CODE:
525 shared_sv* shared = (shared_sv*) SvIV(SvRV(self));
526 SHAREDSvEDIT(shared);
527 av_extend((AV*)SHAREDSvGET(shared), (I32) SvIV(count));
528 SHAREDSvRELEASE(shared);
529
530
531
532
533SV*
534EXISTS(self, index)
535 SV* self
536 SV* index
537 CODE:
538 shared_sv* shared = (shared_sv*) SvIV(SvRV(self));
539 I32 exists;
540 SHAREDSvLOCK(shared);
541 exists = av_exists((AV*) SHAREDSvGET(shared), (I32) SvIV(index));
542 if(exists) {
543 RETVAL = &PL_sv_yes;
544 } else {
545 RETVAL = &PL_sv_no;
546 }
547 SHAREDSvUNLOCK(shared);
548
549void
550STORESIZE(self,count)
551 SV* self
552 SV* count
553 CODE:
554 shared_sv* shared = (shared_sv*) SvIV(SvRV(self));
555 SHAREDSvEDIT(shared);
556 av_fill((AV*) SHAREDSvGET(shared), (I32) SvIV(count));
557 SHAREDSvRELEASE(shared);
558
559SV*
560FETCHSIZE(self)
561 SV* self
562 CODE:
563 shared_sv* shared = (shared_sv*) SvIV(SvRV(self));
564 SHAREDSvLOCK(shared);
565 RETVAL = newSViv(av_len((AV*) SHAREDSvGET(shared)) + 1);
566 SHAREDSvUNLOCK(shared);
567 OUTPUT:
568 RETVAL
569
570SV*
571DELETE(self,index)
572 SV* self
573 SV* index
574 CODE:
575 shared_sv* shared = (shared_sv*) SvIV(SvRV(self));
576 shared_sv* slot;
577 SHAREDSvLOCK(shared);
578 if(av_exists((AV*) SHAREDSvGET(shared), (I32) SvIV(index))) {
579 SV* tmp;
580 SHAREDSvEDIT(shared);
581 tmp = av_delete((AV*)SHAREDSvGET(shared), (I32) SvIV(index),0);
582 SHAREDSvRELEASE(shared);
583 if(SvIV(tmp)) {
584 slot = (shared_sv*) SvIV(tmp);
79a24c1c 585 if(SvROK(SHAREDSvGET(slot))) {
586 shared_sv* target = (shared_sv*) SvIV(SvRV(SHAREDSvGET(slot)));
587 RETVAL = shared_sv_attach_sv(NULL,target);
588 } else {
589 RETVAL = newSVsv(SHAREDSvGET(slot));
590 }
aaf3876d 591 Perl_sharedsv_thrcnt_dec(aTHX_ slot);
592 } else {
593 RETVAL = &PL_sv_undef;
594 }
595 } else {
596 RETVAL = &PL_sv_undef;
597 }
598 SHAREDSvUNLOCK(shared);
599 OUTPUT:
600 RETVAL
601
602AV*
603SPLICE(self, offset, length, ...)
604 SV* self
605 SV* offset
606 SV* length
607 CODE:
608 croak("Splice is not implmented for shared arrays");
609
8669ce85 610MODULE = threads::shared PACKAGE = threads::shared::hv
aaf3876d 611
8669ce85 612SV*
613new(class, value)
614 SV* class
615 SV* value
616 CODE:
617 shared_sv* shared = Perl_sharedsv_new(aTHX);
618 SV* obj = newSViv((IV)shared);
619 SHAREDSvEDIT(shared);
620 SHAREDSvGET(shared) = (SV*) newHV();
621 SHAREDSvRELEASE(shared);
622 RETVAL = obj;
623 OUTPUT:
624 RETVAL
625
626void
627STORE(self, key, value)
628 SV* self
629 SV* key
630 SV* value
631 CODE:
632 shared_sv* shared = (shared_sv*) SvIV(SvRV(self));
633 shared_sv* slot;
634 SV* hentry;
635 SV** hentry_;
636 STRLEN len;
637 char* ckey = SvPV(key, len);
409b1fd3 638 SHAREDSvLOCK(shared);
0d76d117 639 if(SvROK(value)) {
640 shared_sv* target = Perl_sharedsv_find(aTHX_ SvRV(value));
641 if(!target) {
642 Perl_croak(aTHX_ "You cannot assign a non shared reference to a shared hash");
643 }
409b1fd3 644 SHAREDSvEDIT(shared);
0d76d117 645 value = newRV_noinc(newSViv((IV)target));
409b1fd3 646 SHAREDSvRELEASE(shared);
0d76d117 647 }
8669ce85 648 hentry_ = hv_fetch((HV*) SHAREDSvGET(shared), ckey, len, 0);
649 if(hentry_ && SvIV((*hentry_))) {
650 hentry = (*hentry_);
651 slot = (shared_sv*) SvIV(hentry);
652 if(SvROK(SHAREDSvGET(slot)))
653 Perl_sharedsv_thrcnt_dec(aTHX_ (shared_sv*) SvIV(SvRV(SHAREDSvGET(slot))));
654 SHAREDSvEDIT(slot);
655 sv_setsv(SHAREDSvGET(slot), value);
656 SHAREDSvRELEASE(slot);
657 } else {
658 slot = Perl_sharedsv_new(aTHX);
659 SHAREDSvEDIT(shared);
660 SHAREDSvGET(slot) = newSVsv(value);
661 hentry = newSViv((IV)slot);
662 hv_store((HV*) SHAREDSvGET(shared), ckey,len , hentry, 0);
663 SHAREDSvRELEASE(shared);
664 }
0d76d117 665 if(SvROK(SHAREDSvGET(slot)))
666 Perl_sharedsv_thrcnt_inc(aTHX_ (shared_sv*) SvIV(SvRV(SHAREDSvGET(slot))));
8669ce85 667 SHAREDSvUNLOCK(shared);
668
669
670SV*
671FETCH(self, key)
672 SV* self
673 SV* key
674 CODE:
675 shared_sv* shared = (shared_sv*) SvIV(SvRV(self));
676 shared_sv* slot;
677 SV* hentry;
678 SV** hentry_;
679 SV* retval;
680 STRLEN len;
681 char* ckey = SvPV(key, len);
682 SHAREDSvLOCK(shared);
683 hentry_ = hv_fetch((HV*) SHAREDSvGET(shared), ckey, len,0);
684 if(hentry_) {
685 hentry = (*hentry_);
686 if(SvTYPE(hentry) == SVt_NULL) {
687 retval = &PL_sv_undef;
688 } else {
689 slot = (shared_sv*) SvIV(hentry);
0d76d117 690 if(SvROK(SHAREDSvGET(slot))) {
691 shared_sv* target = (shared_sv*) SvIV(SvRV(SHAREDSvGET(slot)));
692 retval = shared_sv_attach_sv(NULL, target);
693 } else {
694 retval = newSVsv(SHAREDSvGET(slot));
695 }
8669ce85 696 }
697 } else {
698 retval = &PL_sv_undef;
699 }
700 SHAREDSvUNLOCK(shared);
701 RETVAL = retval;
702 OUTPUT:
703 RETVAL
704
705void
706CLEAR(self)
707 SV* self
708 CODE:
709 shared_sv* shared = (shared_sv*) SvIV(SvRV(self));
710 shared_sv* slot;
711 HE* entry;
712 SHAREDSvLOCK(shared);
713 Perl_hv_iterinit(PL_sharedsv_space, (HV*) SHAREDSvGET(shared));
714 entry = Perl_hv_iternext(PL_sharedsv_space, (HV*) SHAREDSvGET(shared));
715 while(entry) {
716 slot = (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));
719 }
720 SHAREDSvEDIT(shared);
721 hv_clear((HV*) SHAREDSvGET(shared));
722 SHAREDSvRELEASE(shared);
723 SHAREDSvUNLOCK(shared);
724
725SV*
726FIRSTKEY(self)
727 SV* self
728 CODE:
729 shared_sv* shared = (shared_sv*) SvIV(SvRV(self));
730 char* key = NULL;
731 I32 len;
732 HE* entry;
733 SHAREDSvLOCK(shared);
734 Perl_hv_iterinit(PL_sharedsv_space, (HV*) SHAREDSvGET(shared));
735 entry = Perl_hv_iternext(PL_sharedsv_space, (HV*) SHAREDSvGET(shared));
736 if(entry) {
737 key = Perl_hv_iterkey(PL_sharedsv_space, entry,&len);
738 RETVAL = newSVpv(key, len);
739 } else {
740 RETVAL = &PL_sv_undef;
741 }
742 SHAREDSvUNLOCK(shared);
743 OUTPUT:
744 RETVAL
745
746
747SV*
748NEXTKEY(self, oldkey)
749 SV* self
750 SV* oldkey
751 CODE:
752 shared_sv* shared = (shared_sv*) SvIV(SvRV(self));
753 char* key = NULL;
754 I32 len;
755 HE* entry;
756 SHAREDSvLOCK(shared);
757 entry = Perl_hv_iternext(PL_sharedsv_space, (HV*) SHAREDSvGET(shared));
758 if(entry) {
759 key = Perl_hv_iterkey(PL_sharedsv_space, entry,&len);
760 RETVAL = newSVpv(key, len);
761 } else {
762 RETVAL = &PL_sv_undef;
763 }
764 SHAREDSvUNLOCK(shared);
765 OUTPUT:
766 RETVAL
767
768
769SV*
770EXISTS(self, key)
771 SV* self
772 SV* key
773 CODE:
774 shared_sv* shared = (shared_sv*) SvIV(SvRV(self));
775 STRLEN len;
776 char* ckey = SvPV(key, len);
777 SHAREDSvLOCK(shared);
778 if(hv_exists((HV*)SHAREDSvGET(shared), ckey, len)) {
779 RETVAL = &PL_sv_yes;
780 } else {
781 RETVAL = &PL_sv_no;
782 }
783 SHAREDSvUNLOCK(shared);
784 OUTPUT:
785 RETVAL
786
787SV*
788DELETE(self, key)
789 SV* self
790 SV* key
791 CODE:
792 shared_sv* shared = (shared_sv*) SvIV(SvRV(self));
793 shared_sv* slot;
794 STRLEN len;
795 char* ckey = SvPV(key, len);
796 SV* tmp;
797 SHAREDSvLOCK(shared);
798 SHAREDSvEDIT(shared);
799 tmp = hv_delete((HV*) SHAREDSvGET(shared), ckey, len,0);
800 SHAREDSvRELEASE(shared);
801 if(tmp) {
b48e3745 802 slot = (shared_sv*) SvIV(tmp);
0d76d117 803 if(SvROK(SHAREDSvGET(slot))) {
804 shared_sv* target = (shared_sv*) SvIV(SvRV(SHAREDSvGET(slot)));
805 RETVAL = shared_sv_attach_sv(NULL, target);
806 } else {
807 RETVAL = newSVsv(SHAREDSvGET(slot));
808 }
8669ce85 809 Perl_sharedsv_thrcnt_dec(aTHX_ slot);
810 } else {
811 RETVAL = &PL_sv_undef;
812 }
813 SHAREDSvUNLOCK(shared);
814 OUTPUT:
815 RETVAL
Unnamed repository; edit this file to name it for gitweb.