This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Split out core of sv_magic() into sv_magicext().
[perl5.git] / ext / threads / shared / shared.xs
CommitLineData
b050c948
AB
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);
170958c3 10 SV* id = newSViv(PTR2IV(shared));
b050c948
AB
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
AB
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
AB
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();
170958c3 29 sv_setiv(obj,PTR2IV(shared));
938785a2
AB
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();
170958c3 43 sv_setiv(obj,PTR2IV(shared));
938785a2
AB
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
AB
52 default: {
53 MAGIC* shared_magic;
54 SV* value = newSVsv(SHAREDSvGET(shared));
170958c3 55 SV* obj = newSViv(PTR2IV(shared));
409b1fd3
AB
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;
170958c3 59 shared_magic->mg_obj = newSViv(PTR2IV(shared));
409b1fd3
AB
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
AB
73}
74
75
76int shared_sv_fetch_mg (pTHX_ SV* sv, MAGIC *mg) {
170958c3 77 shared_sv* shared = INT2PTR(shared_sv*, SvIV(mg->mg_obj));
b050c948 78 SHAREDSvLOCK(shared);
55fc11ad
AB
79 if(mg->mg_private != shared->index) {
80 if(SvROK(SHAREDSvGET(shared))) {
170958c3 81 shared_sv* target = INT2PTR(shared_sv*, SvIV(SvRV(SHAREDSvGET(shared))));
55fc11ad
AB
82 shared_sv_attach_sv(sv, target);
83 } else {
84 sv_setsv(sv, SHAREDSvGET(shared));
85 }
86 mg->mg_private = shared->index;
b050c948
AB
87 }
88 SHAREDSvUNLOCK(shared);
89
90 return 0;
91}
92
93int shared_sv_store_mg (pTHX_ SV* sv, MAGIC *mg) {
170958c3 94 shared_sv* shared = INT2PTR(shared_sv*, SvIV(mg->mg_obj));
b050c948
AB
95 SHAREDSvLOCK(shared);
96 if(SvROK(SHAREDSvGET(shared)))
170958c3 97 Perl_sharedsv_thrcnt_dec(aTHX_ INT2PTR(shared_sv*, SvIV(SvRV(SHAREDSvGET(shared)))));
b050c948
AB
98 if(SvROK(sv)) {
99 shared_sv* target = Perl_sharedsv_find(aTHX_ SvRV(sv));
100 if(!target) {
b050c948
AB
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));
170958c3 107 SHAREDSvGET(shared) = newRV_noinc(newSViv(PTR2IV(target)));
b050c948 108 } else {
f70d29d4
AB
109 SHAREDSvEDIT(shared);
110 sv_setsv(SHAREDSvGET(shared), sv);
b050c948 111 }
55fc11ad
AB
112 shared->index++;
113 mg->mg_private = shared->index;
b050c948
AB
114 SHAREDSvRELEASE(shared);
115 if(SvROK(SHAREDSvGET(shared)))
170958c3 116 Perl_sharedsv_thrcnt_inc(aTHX_ INT2PTR(shared_sv*, SvIV(SvRV(SHAREDSvGET(shared)))));
b050c948
AB
117 SHAREDSvUNLOCK(shared);
118 return 0;
119}
120
121int shared_sv_destroy_mg (pTHX_ SV* sv, MAGIC *mg) {
170958c3 122 shared_sv* shared = INT2PTR(shared_sv*, SvIV(mg->mg_obj));
b050c948
AB
123 if(!shared)
124 return 0;
409b1fd3
AB
125 {
126 HV* shared_hv = get_hv("threads::shared::shared", FALSE);
170958c3 127 SV* id = newSViv(PTR2IV(shared));
409b1fd3
AB
128 STRLEN length = sv_len(id);
129 hv_delete(shared_hv, SvPV(id,length), length,0);
130 }
b050c948
AB
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
AB
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
AB
160 shared_sv* shared;
161 if(SvROK(ref))
162 ref = SvRV(ref);
163 shared = Perl_sharedsv_find(aTHX, ref);
b050c948
AB
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
AB
177 CODE:
178 shared_sv* shared;
170958c3 179 PerlInterpreter* origperl = INT2PTR(PerlInterpreter*, SvIV(perl));
cd8c9bf8 180 PerlInterpreter* oldperl = PERL_GET_CONTEXT;
b050c948
AB
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
AB
190void
191_thrcnt_dec(ref)
192 SV* ref
193 CODE:
170958c3 194 shared_sv* shared = INT2PTR(shared_sv*, SvIV(ref));
866fba46
AB
195 if(!shared)
196 croak("thrcnt can only be used on shared values");
197 Perl_sharedsv_thrcnt_dec(aTHX_ shared);
198
6f942b98
AB
199void
200unlock_enabled(ref)
201 SV* ref
ce127893 202 PROTOTYPE: \[$@%]
6f942b98
AB
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
AB
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
AB
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
AB
246
247void cond_signal_enabled(ref)
248 SV* ref
ce127893 249 PROTOTYPE: \[$@%]
6f942b98
AB
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
AB
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
AB
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;
170958c3 281 SV* obj = newSViv(PTR2IV(shared));
b050c948
AB
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;
170958c3 288 shared_magic->mg_obj = newSViv(PTR2IV(shared));
b050c948 289 shared_magic->mg_flags |= MGf_REFCOUNTED;
55fc11ad 290 shared_magic->mg_private = 0;
b050c948
AB
291 SvMAGICAL_on(value);
292 RETVAL = obj;
293 OUTPUT:
294 RETVAL
295
296
aaf3876d
AB
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);
170958c3 305 SV* obj = newSViv(PTR2IV(shared));
aaf3876d
AB
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:
170958c3 319 shared_sv* shared = INT2PTR(shared_sv*, SvIV(SvRV(self)));
aaf3876d
AB
320 shared_sv* slot;
321 SV* aentry;
322 SV** aentry_;
79a24c1c
AB
323 if(SvROK(value)) {
324 shared_sv* target = Perl_sharedsv_find(aTHX_ SvRV(value));
325 if(!target) {
d1be9408 326 Perl_croak(aTHX_ "You cannot assign a non shared reference to a shared array");
79a24c1c 327 }
170958c3 328 value = newRV_noinc(newSViv(PTR2IV(target)));
79a24c1c 329 }
aaf3876d
AB
330 SHAREDSvLOCK(shared);
331 aentry_ = av_fetch((AV*) SHAREDSvGET(shared), SvIV(index), 0);
332 if(aentry_ && SvIV((*aentry_))) {
333 aentry = (*aentry_);
170958c3 334 slot = INT2PTR(shared_sv*, SvIV(aentry));
aaf3876d 335 if(SvROK(SHAREDSvGET(slot)))
170958c3 336 Perl_sharedsv_thrcnt_dec(aTHX_ INT2PTR(shared_sv*, SvIV(SvRV(SHAREDSvGET(slot)))));
aaf3876d
AB
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);
170958c3 344 aentry = newSViv(PTR2IV(slot));
aaf3876d
AB
345 av_store((AV*) SHAREDSvGET(shared), SvIV(index), aentry);
346 SHAREDSvRELEASE(shared);
347 }
79a24c1c 348 if(SvROK(SHAREDSvGET(slot)))
170958c3 349 Perl_sharedsv_thrcnt_inc(aTHX_ INT2PTR(shared_sv*, SvIV(SvRV(SHAREDSvGET(slot)))));
79a24c1c 350
aaf3876d
AB
351 SHAREDSvUNLOCK(shared);
352
353SV*
354FETCH(self, index)
355 SV* self
356 SV* index
357 CODE:
170958c3 358 shared_sv* shared = INT2PTR(shared_sv*, SvIV(SvRV(self)));
aaf3876d
AB
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 {
170958c3 370 slot = INT2PTR(shared_sv*, SvIV(aentry));
79a24c1c 371 if(SvROK(SHAREDSvGET(slot))) {
170958c3 372 shared_sv* target = INT2PTR(shared_sv*, SvIV(SvRV(SHAREDSvGET(slot))));
79a24c1c
AB
373 retval = shared_sv_attach_sv(NULL,target);
374 } else {
375 retval = newSVsv(SHAREDSvGET(slot));
376 }
aaf3876d
AB
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:
170958c3 390 shared_sv* shared = INT2PTR(shared_sv*, SvIV(SvRV(self)));
aaf3876d
AB
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
AB
396 if(SvROK(tmp)) {
397 shared_sv* target = Perl_sharedsv_find(aTHX_ SvRV(tmp));
398 if(!target) {
d1be9408 399 Perl_croak(aTHX_ "You cannot assign a non shared reference to a shared array");
79a24c1c 400 }
170958c3 401 tmp = newRV_noinc(newSViv(PTR2IV(target)));
79a24c1c 402 }
aaf3876d
AB
403 SHAREDSvEDIT(slot);
404 SHAREDSvGET(slot) = newSVsv(tmp);
170958c3 405 av_push((AV*) SHAREDSvGET(shared), newSViv(PTR2IV(slot)));
aaf3876d 406 SHAREDSvRELEASE(slot);
79a24c1c 407 if(SvROK(SHAREDSvGET(slot)))
170958c3 408 Perl_sharedsv_thrcnt_inc(aTHX_ INT2PTR(shared_sv*, SvIV(SvRV(SHAREDSvGET(slot)))));
aaf3876d
AB
409 }
410 SHAREDSvUNLOCK(shared);
411
412void
413UNSHIFT(self, ...)
414 SV* self
415 CODE:
170958c3 416 shared_sv* shared = INT2PTR(shared_sv*, SvIV(SvRV(self)));
aaf3876d
AB
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
AB
425 if(SvROK(tmp)) {
426 shared_sv* target = Perl_sharedsv_find(aTHX_ SvRV(tmp));
427 if(!target) {
d1be9408 428 Perl_croak(aTHX_ "You cannot assign a non shared reference to a shared array");
79a24c1c 429 }
170958c3 430 tmp = newRV_noinc(newSViv(PTR2IV(target)));
79a24c1c 431 }
aaf3876d
AB
432 SHAREDSvEDIT(slot);
433 SHAREDSvGET(slot) = newSVsv(tmp);
170958c3 434 av_store((AV*) SHAREDSvGET(shared), i - 1, newSViv(PTR2IV(slot)));
aaf3876d 435 SHAREDSvRELEASE(slot);
79a24c1c 436 if(SvROK(SHAREDSvGET(slot)))
170958c3 437 Perl_sharedsv_thrcnt_inc(aTHX_ INT2PTR(shared_sv*, SvIV(SvRV(SHAREDSvGET(slot)))));
aaf3876d
AB
438 }
439 SHAREDSvUNLOCK(shared);
440
441SV*
442POP(self)
443 SV* self
444 CODE:
170958c3 445 shared_sv* shared = INT2PTR(shared_sv*, SvIV(SvRV(self)));
aaf3876d
AB
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)) {
170958c3 453 slot = INT2PTR(shared_sv*, SvIV(retval));
79a24c1c 454 if(SvROK(SHAREDSvGET(slot))) {
170958c3 455 shared_sv* target = INT2PTR(shared_sv*, SvIV(SvRV(SHAREDSvGET(slot))));
79a24c1c
AB
456 retval = shared_sv_attach_sv(NULL,target);
457 } else {
458 retval = newSVsv(SHAREDSvGET(slot));
459 }
aaf3876d
AB
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:
170958c3 474 shared_sv* shared = INT2PTR(shared_sv*, SvIV(SvRV(self)));
aaf3876d
AB
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)) {
170958c3 482 slot = INT2PTR(shared_sv*, SvIV(retval));
79a24c1c 483 if(SvROK(SHAREDSvGET(slot))) {
170958c3 484 shared_sv* target = INT2PTR(shared_sv*, SvIV(SvRV(SHAREDSvGET(slot))));
79a24c1c
AB
485 retval = shared_sv_attach_sv(NULL,target);
486 } else {
487 retval = newSVsv(SHAREDSvGET(slot));
488 }
aaf3876d
AB
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:
170958c3 502 shared_sv* shared = INT2PTR(shared_sv*, SvIV(SvRV(self)));
aaf3876d
AB
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])) {
170958c3 511 Perl_sharedsv_thrcnt_dec(aTHX_ INT2PTR(shared_sv*, SvIV(svp[i])));
aaf3876d
AB
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:
170958c3 525 shared_sv* shared = INT2PTR(shared_sv*, SvIV(SvRV(self)));
aaf3876d
AB
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:
170958c3 538 shared_sv* shared = INT2PTR(shared_sv*, SvIV(SvRV(self)));
aaf3876d
AB
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:
170958c3 554 shared_sv* shared = INT2PTR(shared_sv*, SvIV(SvRV(self)));
aaf3876d
AB
555 SHAREDSvEDIT(shared);
556 av_fill((AV*) SHAREDSvGET(shared), (I32) SvIV(count));
557 SHAREDSvRELEASE(shared);
558
559SV*
560FETCHSIZE(self)
561 SV* self
562 CODE:
170958c3 563 shared_sv* shared = INT2PTR(shared_sv*, SvIV(SvRV(self)));
aaf3876d
AB
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:
170958c3 575 shared_sv* shared = INT2PTR(shared_sv*, SvIV(SvRV(self)));
aaf3876d
AB
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)) {
170958c3 584 slot = INT2PTR(shared_sv*, SvIV(tmp));
79a24c1c 585 if(SvROK(SHAREDSvGET(slot))) {
170958c3 586 shared_sv* target = INT2PTR(shared_sv*, SvIV(SvRV(SHAREDSvGET(slot))));
79a24c1c
AB
587 RETVAL = shared_sv_attach_sv(NULL,target);
588 } else {
589 RETVAL = newSVsv(SHAREDSvGET(slot));
590 }
aaf3876d
AB
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
AB
612SV*
613new(class, value)
614 SV* class
615 SV* value
616 CODE:
617 shared_sv* shared = Perl_sharedsv_new(aTHX);
170958c3 618 SV* obj = newSViv(PTR2IV(shared));
8669ce85
AB
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:
170958c3 632 shared_sv* shared = INT2PTR(shared_sv*, SvIV(SvRV(self)));
8669ce85
AB
633 shared_sv* slot;
634 SV* hentry;
635 SV** hentry_;
636 STRLEN len;
637 char* ckey = SvPV(key, len);
409b1fd3 638 SHAREDSvLOCK(shared);
0d76d117
AB
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);
170958c3 645 value = newRV_noinc(newSViv(PTR2IV(target)));
409b1fd3 646 SHAREDSvRELEASE(shared);
0d76d117 647 }
8669ce85
AB
648 hentry_ = hv_fetch((HV*) SHAREDSvGET(shared), ckey, len, 0);
649 if(hentry_ && SvIV((*hentry_))) {
650 hentry = (*hentry_);
170958c3 651 slot = INT2PTR(shared_sv*, SvIV(hentry));
8669ce85 652 if(SvROK(SHAREDSvGET(slot)))
170958c3 653 Perl_sharedsv_thrcnt_dec(aTHX_ INT2PTR(shared_sv*, SvIV(SvRV(SHAREDSvGET(slot)))));
8669ce85
AB
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);
170958c3 661 hentry = newSViv(PTR2IV(slot));
8669ce85
AB
662 hv_store((HV*) SHAREDSvGET(shared), ckey,len , hentry, 0);
663 SHAREDSvRELEASE(shared);
664 }
0d76d117 665 if(SvROK(SHAREDSvGET(slot)))
170958c3 666 Perl_sharedsv_thrcnt_inc(aTHX_ INT2PTR(shared_sv*, SvIV(SvRV(SHAREDSvGET(slot)))));
8669ce85
AB
667 SHAREDSvUNLOCK(shared);
668
669
670SV*
671FETCH(self, key)
672 SV* self
673 SV* key
674 CODE:
170958c3 675 shared_sv* shared = INT2PTR(shared_sv*, SvIV(SvRV(self)));
8669ce85
AB
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 {
170958c3 689 slot = INT2PTR(shared_sv*, SvIV(hentry));
0d76d117 690 if(SvROK(SHAREDSvGET(slot))) {
170958c3 691 shared_sv* target = INT2PTR(shared_sv*, SvIV(SvRV(SHAREDSvGET(slot))));
0d76d117
AB
692 retval = shared_sv_attach_sv(NULL, target);
693 } else {
694 retval = newSVsv(SHAREDSvGET(slot));
695 }
8669ce85
AB
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:
170958c3 709 shared_sv* shared = INT2PTR(shared_sv*, SvIV(SvRV(self)));
8669ce85
AB
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) {
170958c3 716 slot = INT2PTR(shared_sv*, SvIV(Perl_hv_iterval(PL_sharedsv_space, (HV*) SHAREDSvGET(shared), entry)));
8669ce85
AB
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:
170958c3 729 shared_sv* shared = INT2PTR(shared_sv*, SvIV(SvRV(self)));
8669ce85
AB
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:
170958c3 752 shared_sv* shared = INT2PTR(shared_sv*, SvIV(SvRV(self)));
8669ce85
AB
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:
170958c3 774 shared_sv* shared = INT2PTR(shared_sv*, SvIV(SvRV(self)));
8669ce85
AB
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:
170958c3 792 shared_sv* shared = INT2PTR(shared_sv*, SvIV(SvRV(self)));
8669ce85
AB
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) {
170958c3 802 slot = INT2PTR(shared_sv*, SvIV(tmp));
0d76d117 803 if(SvROK(SHAREDSvGET(slot))) {
170958c3 804 shared_sv* target = INT2PTR(shared_sv*, SvIV(SvRV(SHAREDSvGET(slot))));
0d76d117
AB
805 RETVAL = shared_sv_attach_sv(NULL, target);
806 } else {
807 RETVAL = newSVsv(SHAREDSvGET(slot));
808 }
8669ce85
AB
809 Perl_sharedsv_thrcnt_dec(aTHX_ slot);
810 } else {
811 RETVAL = &PL_sv_undef;
812 }
813 SHAREDSvUNLOCK(shared);
814 OUTPUT:
815 RETVAL