projects / p5sagit/p5-mst-13.2.git / blame
? search:
summary | shortlog | log | commit | commitdiff | tree
blob | history | HEAD
Integrate change #12752 from maintperl;
[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
174thrcnt_inc(ref)
175 SV* ref
176 CODE:
177 shared_sv* shared;
178 if(SvROK(ref))
179 ref = SvRV(ref);
180 shared = Perl_sharedsv_find(aTHX, ref);
181 if(!shared)
182 croak("thrcnt can only be used on shared values");
183 Perl_sharedsv_thrcnt_inc(aTHX_ shared);
184
866fba46 185void
186_thrcnt_dec(ref)
187 SV* ref
188 CODE:
189 shared_sv* shared = (shared_sv*) SvIV(ref);
190 if(!shared)
191 croak("thrcnt can only be used on shared values");
192 Perl_sharedsv_thrcnt_dec(aTHX_ shared);
193
6f942b98 194void
195unlock_enabled(ref)
196 SV* ref
ce127893 197 PROTOTYPE: \[$@%]
6f942b98 198 CODE:
199 shared_sv* shared;
200 if(SvROK(ref))
201 ref = SvRV(ref);
202 shared = Perl_sharedsv_find(aTHX, ref);
203 if(!shared)
204 croak("unlock can only be used on shared values");
205 SHAREDSvUNLOCK(shared);
206
207void
208lock_enabled(ref)
209 SV* ref
6f942b98 210 CODE:
211 shared_sv* shared;
212 if(SvROK(ref))
213 ref = SvRV(ref);
214 shared = Perl_sharedsv_find(aTHX, ref);
215 if(!shared)
216 croak("lock can only be used on shared values");
217 SHAREDSvLOCK(shared);
218
219
220void
221cond_wait_enabled(ref)
222 SV* ref
ce127893 223 PROTOTYPE: \[$@%]
6f942b98 224 CODE:
225 shared_sv* shared;
226 int locks;
227 if(SvROK(ref))
228 ref = SvRV(ref);
229 shared = Perl_sharedsv_find(aTHX_ ref);
230 if(!shared)
231 croak("cond_wait can only be used on shared values");
232 if(shared->owner != PERL_GET_CONTEXT)
233 croak("You need a lock before you can cond_wait");
234 MUTEX_LOCK(&shared->mutex);
235 shared->owner = NULL;
236 locks = shared->locks = 0;
237 COND_WAIT(&shared->user_cond, &shared->mutex);
238 shared->owner = PERL_GET_CONTEXT;
239 shared->locks = locks;
a6b94e59 240 MUTEX_UNLOCK(&shared->mutex);
6f942b98 241
242void cond_signal_enabled(ref)
243 SV* ref
ce127893 244 PROTOTYPE: \[$@%]
6f942b98 245 CODE:
246 shared_sv* shared;
247 if(SvROK(ref))
248 ref = SvRV(ref);
249 shared = Perl_sharedsv_find(aTHX_ ref);
250 if(!shared)
251 croak("cond_signal can only be used on shared values");
252 COND_SIGNAL(&shared->user_cond);
253
254
255void cond_broadcast_enabled(ref)
256 SV* ref
ce127893 257 PROTOTYPE: \[$@%]
6f942b98 258 CODE:
259 shared_sv* shared;
260 if(SvROK(ref))
261 ref = SvRV(ref);
262 shared = Perl_sharedsv_find(aTHX_ ref);
263 if(!shared)
264 croak("cond_broadcast can only be used on shared values");
265 COND_BROADCAST(&shared->user_cond);
b050c948 266
267MODULE = threads::shared PACKAGE = threads::shared::sv
268
269SV*
270new(class, value)
271 SV* class
272 SV* value
273 CODE:
274 shared_sv* shared = Perl_sharedsv_new(aTHX);
275 MAGIC* shared_magic;
276 SV* obj = newSViv((IV)shared);
277 SHAREDSvEDIT(shared);
278 SHAREDSvGET(shared) = newSVsv(value);
279 SHAREDSvRELEASE(shared);
280 sv_magic(value, 0, PERL_MAGIC_ext, "threads::shared", 16);
281 shared_magic = mg_find(value, PERL_MAGIC_ext);
282 shared_magic->mg_virtual = &svtable;
283 shared_magic->mg_obj = newSViv((IV)shared);
284 shared_magic->mg_flags |= MGf_REFCOUNTED;
55fc11ad 285 shared_magic->mg_private = 0;
b050c948 286 SvMAGICAL_on(value);
287 RETVAL = obj;
288 OUTPUT:
289 RETVAL
290
291
aaf3876d 292MODULE = threads::shared PACKAGE = threads::shared::av
293
294SV*
295new(class, value)
296 SV* class
297 SV* value
298 CODE:
299 shared_sv* shared = Perl_sharedsv_new(aTHX);
300 SV* obj = newSViv((IV)shared);
301 SHAREDSvEDIT(shared);
302 SHAREDSvGET(shared) = (SV*) newAV();
303 SHAREDSvRELEASE(shared);
304 RETVAL = obj;
305 OUTPUT:
306 RETVAL
307
308void
309STORE(self, index, value)
310 SV* self
311 SV* index
312 SV* value
313 CODE:
314 shared_sv* shared = (shared_sv*) SvIV(SvRV(self));
315 shared_sv* slot;
316 SV* aentry;
317 SV** aentry_;
79a24c1c 318 if(SvROK(value)) {
319 shared_sv* target = Perl_sharedsv_find(aTHX_ SvRV(value));
320 if(!target) {
321 Perl_croak(aTHX_ "You cannot assign a non shared reference to an shared array");
322 }
323 value = newRV_noinc(newSViv((IV)target));
324 }
aaf3876d 325 SHAREDSvLOCK(shared);
326 aentry_ = av_fetch((AV*) SHAREDSvGET(shared), SvIV(index), 0);
327 if(aentry_ && SvIV((*aentry_))) {
328 aentry = (*aentry_);
329 slot = (shared_sv*) SvIV(aentry);
330 if(SvROK(SHAREDSvGET(slot)))
331 Perl_sharedsv_thrcnt_dec(aTHX_ (shared_sv*) SvIV(SvRV(SHAREDSvGET(slot))));
332 SHAREDSvEDIT(slot);
333 sv_setsv(SHAREDSvGET(slot), value);
334 SHAREDSvRELEASE(slot);
335 } else {
336 slot = Perl_sharedsv_new(aTHX);
337 SHAREDSvEDIT(shared);
338 SHAREDSvGET(slot) = newSVsv(value);
339 aentry = newSViv((IV)slot);
340 av_store((AV*) SHAREDSvGET(shared), SvIV(index), aentry);
341 SHAREDSvRELEASE(shared);
342 }
79a24c1c 343 if(SvROK(SHAREDSvGET(slot)))
344 Perl_sharedsv_thrcnt_inc(aTHX_ (shared_sv*) SvIV(SvRV(SHAREDSvGET(slot))));
345
aaf3876d 346 SHAREDSvUNLOCK(shared);
347
348SV*
349FETCH(self, index)
350 SV* self
351 SV* index
352 CODE:
353 shared_sv* shared = (shared_sv*) SvIV(SvRV(self));
354 shared_sv* slot;
355 SV* aentry;
356 SV** aentry_;
357 SV* retval;
358 SHAREDSvLOCK(shared);
359 aentry_ = av_fetch((AV*) SHAREDSvGET(shared), SvIV(index),0);
360 if(aentry_) {
361 aentry = (*aentry_);
362 if(SvTYPE(aentry) == SVt_NULL) {
363 retval = &PL_sv_undef;
364 } else {
365 slot = (shared_sv*) SvIV(aentry);
79a24c1c 366 if(SvROK(SHAREDSvGET(slot))) {
367 shared_sv* target = (shared_sv*) SvIV(SvRV(SHAREDSvGET(slot)));
368 retval = shared_sv_attach_sv(NULL,target);
369 } else {
370 retval = newSVsv(SHAREDSvGET(slot));
371 }
aaf3876d 372 }
373 } else {
374 retval = &PL_sv_undef;
375 }
376 SHAREDSvUNLOCK(shared);
377 RETVAL = retval;
378 OUTPUT:
379 RETVAL
380
381void
382PUSH(self, ...)
383 SV* self
384 CODE:
385 shared_sv* shared = (shared_sv*) SvIV(SvRV(self));
386 int i;
387 SHAREDSvLOCK(shared);
388 for(i = 1; i < items; i++) {
389 shared_sv* slot = Perl_sharedsv_new(aTHX);
390 SV* tmp = ST(i);
79a24c1c 391 if(SvROK(tmp)) {
392 shared_sv* target = Perl_sharedsv_find(aTHX_ SvRV(tmp));
393 if(!target) {
394 Perl_croak(aTHX_ "You cannot assign a non shared reference to an shared array");
395 }
396 tmp = newRV_noinc(newSViv((IV)target));
397 }
aaf3876d 398 SHAREDSvEDIT(slot);
399 SHAREDSvGET(slot) = newSVsv(tmp);
400 av_push((AV*) SHAREDSvGET(shared), newSViv((IV)slot));
401 SHAREDSvRELEASE(slot);
79a24c1c 402 if(SvROK(SHAREDSvGET(slot)))
403 Perl_sharedsv_thrcnt_inc(aTHX_ (shared_sv*) SvIV(SvRV(SHAREDSvGET(slot))));
aaf3876d 404 }
405 SHAREDSvUNLOCK(shared);
406
407void
408UNSHIFT(self, ...)
409 SV* self
410 CODE:
411 shared_sv* shared = (shared_sv*) SvIV(SvRV(self));
412 int i;
413 SHAREDSvLOCK(shared);
414 SHAREDSvEDIT(shared);
415 av_unshift((AV*)SHAREDSvGET(shared), items - 1);
416 SHAREDSvRELEASE(shared);
417 for(i = 1; i < items; i++) {
418 shared_sv* slot = Perl_sharedsv_new(aTHX);
419 SV* tmp = ST(i);
79a24c1c 420 if(SvROK(tmp)) {
421 shared_sv* target = Perl_sharedsv_find(aTHX_ SvRV(tmp));
422 if(!target) {
423 Perl_croak(aTHX_ "You cannot assign a non shared reference to an shared array");
424 }
425 tmp = newRV_noinc(newSViv((IV)target));
426 }
aaf3876d 427 SHAREDSvEDIT(slot);
428 SHAREDSvGET(slot) = newSVsv(tmp);
429 av_store((AV*) SHAREDSvGET(shared), i - 1, newSViv((IV)slot));
430 SHAREDSvRELEASE(slot);
79a24c1c 431 if(SvROK(SHAREDSvGET(slot)))
432 Perl_sharedsv_thrcnt_inc(aTHX_ (shared_sv*) SvIV(SvRV(SHAREDSvGET(slot))));
aaf3876d 433 }
434 SHAREDSvUNLOCK(shared);
435
436SV*
437POP(self)
438 SV* self
439 CODE:
440 shared_sv* shared = (shared_sv*) SvIV(SvRV(self));
441 shared_sv* slot;
442 SV* retval;
443 SHAREDSvLOCK(shared);
444 SHAREDSvEDIT(shared);
445 retval = av_pop((AV*)SHAREDSvGET(shared));
446 SHAREDSvRELEASE(shared);
447 if(retval && SvIV(retval)) {
448 slot = (shared_sv*) SvIV(retval);
79a24c1c 449 if(SvROK(SHAREDSvGET(slot))) {
450 shared_sv* target = (shared_sv*) SvIV(SvRV(SHAREDSvGET(slot)));
451 retval = shared_sv_attach_sv(NULL,target);
452 } else {
453 retval = newSVsv(SHAREDSvGET(slot));
454 }
aaf3876d 455 Perl_sharedsv_thrcnt_dec(aTHX_ slot);
456 } else {
457 retval = &PL_sv_undef;
458 }
459 SHAREDSvUNLOCK(shared);
460 RETVAL = retval;
461 OUTPUT:
462 RETVAL
463
464
465SV*
466SHIFT(self)
467 SV* self
468 CODE:
469 shared_sv* shared = (shared_sv*) SvIV(SvRV(self));
470 shared_sv* slot;
471 SV* retval;
472 SHAREDSvLOCK(shared);
473 SHAREDSvEDIT(shared);
474 retval = av_shift((AV*)SHAREDSvGET(shared));
475 SHAREDSvRELEASE(shared);
476 if(retval && SvIV(retval)) {
477 slot = (shared_sv*) SvIV(retval);
79a24c1c 478 if(SvROK(SHAREDSvGET(slot))) {
479 shared_sv* target = (shared_sv*) SvIV(SvRV(SHAREDSvGET(slot)));
480 retval = shared_sv_attach_sv(NULL,target);
481 } else {
482 retval = newSVsv(SHAREDSvGET(slot));
483 }
aaf3876d 484 Perl_sharedsv_thrcnt_dec(aTHX_ slot);
485 } else {
486 retval = &PL_sv_undef;
487 }
488 SHAREDSvUNLOCK(shared);
489 RETVAL = retval;
490 OUTPUT:
491 RETVAL
492
493void
494CLEAR(self)
495 SV* self
496 CODE:
497 shared_sv* shared = (shared_sv*) SvIV(SvRV(self));
498 shared_sv* slot;
499 SV** svp;
500 I32 i;
501 SHAREDSvLOCK(shared);
502 svp = AvARRAY((AV*)SHAREDSvGET(shared));
503 i = AvFILLp((AV*)SHAREDSvGET(shared));
504 while ( i >= 0) {
505 if(SvIV(svp[i])) {
506 Perl_sharedsv_thrcnt_dec(aTHX_ (shared_sv*) SvIV(svp[i]));
507 }
508 i--;
509 }
510 SHAREDSvEDIT(shared);
511 av_clear((AV*)SHAREDSvGET(shared));
512 SHAREDSvRELEASE(shared);
513 SHAREDSvUNLOCK(shared);
514
515void
516EXTEND(self, count)
517 SV* self
518 SV* count
519 CODE:
520 shared_sv* shared = (shared_sv*) SvIV(SvRV(self));
521 SHAREDSvEDIT(shared);
522 av_extend((AV*)SHAREDSvGET(shared), (I32) SvIV(count));
523 SHAREDSvRELEASE(shared);
524
525
526
527
528SV*
529EXISTS(self, index)
530 SV* self
531 SV* index
532 CODE:
533 shared_sv* shared = (shared_sv*) SvIV(SvRV(self));
534 I32 exists;
535 SHAREDSvLOCK(shared);
536 exists = av_exists((AV*) SHAREDSvGET(shared), (I32) SvIV(index));
537 if(exists) {
538 RETVAL = &PL_sv_yes;
539 } else {
540 RETVAL = &PL_sv_no;
541 }
542 SHAREDSvUNLOCK(shared);
543
544void
545STORESIZE(self,count)
546 SV* self
547 SV* count
548 CODE:
549 shared_sv* shared = (shared_sv*) SvIV(SvRV(self));
550 SHAREDSvEDIT(shared);
551 av_fill((AV*) SHAREDSvGET(shared), (I32) SvIV(count));
552 SHAREDSvRELEASE(shared);
553
554SV*
555FETCHSIZE(self)
556 SV* self
557 CODE:
558 shared_sv* shared = (shared_sv*) SvIV(SvRV(self));
559 SHAREDSvLOCK(shared);
560 RETVAL = newSViv(av_len((AV*) SHAREDSvGET(shared)) + 1);
561 SHAREDSvUNLOCK(shared);
562 OUTPUT:
563 RETVAL
564
565SV*
566DELETE(self,index)
567 SV* self
568 SV* index
569 CODE:
570 shared_sv* shared = (shared_sv*) SvIV(SvRV(self));
571 shared_sv* slot;
572 SHAREDSvLOCK(shared);
573 if(av_exists((AV*) SHAREDSvGET(shared), (I32) SvIV(index))) {
574 SV* tmp;
575 SHAREDSvEDIT(shared);
576 tmp = av_delete((AV*)SHAREDSvGET(shared), (I32) SvIV(index),0);
577 SHAREDSvRELEASE(shared);
578 if(SvIV(tmp)) {
579 slot = (shared_sv*) SvIV(tmp);
79a24c1c 580 if(SvROK(SHAREDSvGET(slot))) {
581 shared_sv* target = (shared_sv*) SvIV(SvRV(SHAREDSvGET(slot)));
582 RETVAL = shared_sv_attach_sv(NULL,target);
583 } else {
584 RETVAL = newSVsv(SHAREDSvGET(slot));
585 }
aaf3876d 586 Perl_sharedsv_thrcnt_dec(aTHX_ slot);
587 } else {
588 RETVAL = &PL_sv_undef;
589 }
590 } else {
591 RETVAL = &PL_sv_undef;
592 }
593 SHAREDSvUNLOCK(shared);
594 OUTPUT:
595 RETVAL
596
597AV*
598SPLICE(self, offset, length, ...)
599 SV* self
600 SV* offset
601 SV* length
602 CODE:
603 croak("Splice is not implmented for shared arrays");
604
8669ce85 605MODULE = threads::shared PACKAGE = threads::shared::hv
aaf3876d 606
8669ce85 607SV*
608new(class, value)
609 SV* class
610 SV* value
611 CODE:
612 shared_sv* shared = Perl_sharedsv_new(aTHX);
613 SV* obj = newSViv((IV)shared);
614 SHAREDSvEDIT(shared);
615 SHAREDSvGET(shared) = (SV*) newHV();
616 SHAREDSvRELEASE(shared);
617 RETVAL = obj;
618 OUTPUT:
619 RETVAL
620
621void
622STORE(self, key, value)
623 SV* self
624 SV* key
625 SV* value
626 CODE:
627 shared_sv* shared = (shared_sv*) SvIV(SvRV(self));
628 shared_sv* slot;
629 SV* hentry;
630 SV** hentry_;
631 STRLEN len;
632 char* ckey = SvPV(key, len);
409b1fd3 633 SHAREDSvLOCK(shared);
0d76d117 634 if(SvROK(value)) {
635 shared_sv* target = Perl_sharedsv_find(aTHX_ SvRV(value));
636 if(!target) {
637 Perl_croak(aTHX_ "You cannot assign a non shared reference to a shared hash");
638 }
409b1fd3 639 SHAREDSvEDIT(shared);
0d76d117 640 value = newRV_noinc(newSViv((IV)target));
409b1fd3 641 SHAREDSvRELEASE(shared);
0d76d117 642 }
8669ce85 643 hentry_ = hv_fetch((HV*) SHAREDSvGET(shared), ckey, len, 0);
644 if(hentry_ && SvIV((*hentry_))) {
645 hentry = (*hentry_);
646 slot = (shared_sv*) SvIV(hentry);
647 if(SvROK(SHAREDSvGET(slot)))
648 Perl_sharedsv_thrcnt_dec(aTHX_ (shared_sv*) SvIV(SvRV(SHAREDSvGET(slot))));
649 SHAREDSvEDIT(slot);
650 sv_setsv(SHAREDSvGET(slot), value);
651 SHAREDSvRELEASE(slot);
652 } else {
653 slot = Perl_sharedsv_new(aTHX);
654 SHAREDSvEDIT(shared);
655 SHAREDSvGET(slot) = newSVsv(value);
656 hentry = newSViv((IV)slot);
657 hv_store((HV*) SHAREDSvGET(shared), ckey,len , hentry, 0);
658 SHAREDSvRELEASE(shared);
659 }
0d76d117 660 if(SvROK(SHAREDSvGET(slot)))
661 Perl_sharedsv_thrcnt_inc(aTHX_ (shared_sv*) SvIV(SvRV(SHAREDSvGET(slot))));
8669ce85 662 SHAREDSvUNLOCK(shared);
663
664
665SV*
666FETCH(self, key)
667 SV* self
668 SV* key
669 CODE:
670 shared_sv* shared = (shared_sv*) SvIV(SvRV(self));
671 shared_sv* slot;
672 SV* hentry;
673 SV** hentry_;
674 SV* retval;
675 STRLEN len;
676 char* ckey = SvPV(key, len);
677 SHAREDSvLOCK(shared);
678 hentry_ = hv_fetch((HV*) SHAREDSvGET(shared), ckey, len,0);
679 if(hentry_) {
680 hentry = (*hentry_);
681 if(SvTYPE(hentry) == SVt_NULL) {
682 retval = &PL_sv_undef;
683 } else {
684 slot = (shared_sv*) SvIV(hentry);
0d76d117 685 if(SvROK(SHAREDSvGET(slot))) {
686 shared_sv* target = (shared_sv*) SvIV(SvRV(SHAREDSvGET(slot)));
687 retval = shared_sv_attach_sv(NULL, target);
688 } else {
689 retval = newSVsv(SHAREDSvGET(slot));
690 }
8669ce85 691 }
692 } else {
693 retval = &PL_sv_undef;
694 }
695 SHAREDSvUNLOCK(shared);
696 RETVAL = retval;
697 OUTPUT:
698 RETVAL
699
700void
701CLEAR(self)
702 SV* self
703 CODE:
704 shared_sv* shared = (shared_sv*) SvIV(SvRV(self));
705 shared_sv* slot;
706 HE* entry;
707 SHAREDSvLOCK(shared);
708 Perl_hv_iterinit(PL_sharedsv_space, (HV*) SHAREDSvGET(shared));
709 entry = Perl_hv_iternext(PL_sharedsv_space, (HV*) SHAREDSvGET(shared));
710 while(entry) {
711 slot = (shared_sv*) SvIV(Perl_hv_iterval(PL_sharedsv_space, (HV*) SHAREDSvGET(shared), entry));
712 Perl_sharedsv_thrcnt_dec(aTHX_ slot);
713 entry = Perl_hv_iternext(PL_sharedsv_space,(HV*) SHAREDSvGET(shared));
714 }
715 SHAREDSvEDIT(shared);
716 hv_clear((HV*) SHAREDSvGET(shared));
717 SHAREDSvRELEASE(shared);
718 SHAREDSvUNLOCK(shared);
719
720SV*
721FIRSTKEY(self)
722 SV* self
723 CODE:
724 shared_sv* shared = (shared_sv*) SvIV(SvRV(self));
725 char* key = NULL;
726 I32 len;
727 HE* entry;
728 SHAREDSvLOCK(shared);
729 Perl_hv_iterinit(PL_sharedsv_space, (HV*) SHAREDSvGET(shared));
730 entry = Perl_hv_iternext(PL_sharedsv_space, (HV*) SHAREDSvGET(shared));
731 if(entry) {
732 key = Perl_hv_iterkey(PL_sharedsv_space, entry,&len);
733 RETVAL = newSVpv(key, len);
734 } else {
735 RETVAL = &PL_sv_undef;
736 }
737 SHAREDSvUNLOCK(shared);
738 OUTPUT:
739 RETVAL
740
741
742SV*
743NEXTKEY(self, oldkey)
744 SV* self
745 SV* oldkey
746 CODE:
747 shared_sv* shared = (shared_sv*) SvIV(SvRV(self));
748 char* key = NULL;
749 I32 len;
750 HE* entry;
751 SHAREDSvLOCK(shared);
752 entry = Perl_hv_iternext(PL_sharedsv_space, (HV*) SHAREDSvGET(shared));
753 if(entry) {
754 key = Perl_hv_iterkey(PL_sharedsv_space, entry,&len);
755 RETVAL = newSVpv(key, len);
756 } else {
757 RETVAL = &PL_sv_undef;
758 }
759 SHAREDSvUNLOCK(shared);
760 OUTPUT:
761 RETVAL
762
763
764SV*
765EXISTS(self, key)
766 SV* self
767 SV* key
768 CODE:
769 shared_sv* shared = (shared_sv*) SvIV(SvRV(self));
770 STRLEN len;
771 char* ckey = SvPV(key, len);
772 SHAREDSvLOCK(shared);
773 if(hv_exists((HV*)SHAREDSvGET(shared), ckey, len)) {
774 RETVAL = &PL_sv_yes;
775 } else {
776 RETVAL = &PL_sv_no;
777 }
778 SHAREDSvUNLOCK(shared);
779 OUTPUT:
780 RETVAL
781
782SV*
783DELETE(self, key)
784 SV* self
785 SV* key
786 CODE:
787 shared_sv* shared = (shared_sv*) SvIV(SvRV(self));
788 shared_sv* slot;
789 STRLEN len;
790 char* ckey = SvPV(key, len);
791 SV* tmp;
792 SHAREDSvLOCK(shared);
793 SHAREDSvEDIT(shared);
794 tmp = hv_delete((HV*) SHAREDSvGET(shared), ckey, len,0);
795 SHAREDSvRELEASE(shared);
796 if(tmp) {
b48e3745 797 slot = (shared_sv*) SvIV(tmp);
0d76d117 798 if(SvROK(SHAREDSvGET(slot))) {
799 shared_sv* target = (shared_sv*) SvIV(SvRV(SHAREDSvGET(slot)));
800 RETVAL = shared_sv_attach_sv(NULL, target);
801 } else {
802 RETVAL = newSVsv(SHAREDSvGET(slot));
803 }
8669ce85 804 Perl_sharedsv_thrcnt_dec(aTHX_ slot);
805 } else {
806 RETVAL = &PL_sv_undef;
807 }
808 SHAREDSvUNLOCK(shared);
809 OUTPUT:
810 RETVAL
Unnamed repository; edit this file to name it for gitweb.