projects / p5sagit/p5-mst-13.2.git / blame
? search:
summary | shortlog | log | commit | commitdiff | tree
blob | history | HEAD
threads work again on Win32. (Not threads::shared yet)
[p5sagit/p5-mst-13.2.git] / ext / threads / shared / shared.xs
CommitLineData
68795e93 1/* sharedsv.c
2 *
3 * Copyright (c) 2001, Larry Wall
4 *
5 * You may distribute under the terms of either the GNU General Public
6 * License or the Artistic License, as specified in the README file.
7 *
8 */
b050c948 9
68795e93 10/*
11* Contributed by Arthur Bergman arthur@contiller.se
12*
13* "Hand any two wizards a piece of rope and they would instinctively pull in
14* opposite directions."
15* --Sourcery
16*
17*/
18
19#define PERL_NO_GET_CONTEXT
b050c948 20#include "EXTERN.h"
21#include "perl.h"
22#include "XSUB.h"
23
68795e93 24PerlInterpreter *PL_sharedsv_space; /* The shared sv space */
25perl_mutex PL_sharedsv_space_mutex; /* Mutex protecting the shared sv space */
26
27typedef struct {
28 SV *sv; /* The actual SV */
29 perl_mutex mutex; /* Our mutex */
30 perl_cond cond; /* Our condition variable */
31 perl_cond user_cond; /* For user-level conditions */
32 IV locks; /* Number of locks held */
33 PerlInterpreter *owner; /* Who owns the lock? */
34 U16 index; /* Update index */
35} shared_sv;
36
37#define SHAREDSvGET(a) (a->sv)
38#define SHAREDSvLOCK(a) Perl_sharedsv_lock(aTHX_ a)
39#define SHAREDSvUNLOCK(a) Perl_sharedsv_unlock(aTHX_ a)
40
41#define SHAREDSvEDIT(a) STMT_START { \
42 MUTEX_LOCK(&PL_sharedsv_space_mutex); \
43 SHAREDSvLOCK((a)); \
44 PERL_SET_CONTEXT(PL_sharedsv_space); \
45 } STMT_END
46
47#define SHAREDSvRELEASE(a) STMT_START { \
48 PERL_SET_CONTEXT((a)->owner); \
49 SHAREDSvUNLOCK((a)); \
50 MUTEX_UNLOCK(&PL_sharedsv_space_mutex); \
51 } STMT_END
52
53extern void Perl_sharedsv_init(pTHX);
54extern shared_sv* Perl_sharedsv_new(pTHX);
55extern shared_sv* Perl_sharedsv_find(pTHX_ SV* sv);
56extern void Perl_sharedsv_lock(pTHX_ shared_sv* ssv);
57extern void Perl_sharedsv_unlock(pTHX_ shared_sv* ssv);
58extern void Perl_sharedsv_unlock_scope(pTHX_ shared_sv* ssv);
59extern void Perl_sharedsv_thrcnt_inc(pTHX_ shared_sv* ssv);
60extern void Perl_sharedsv_thrcnt_dec(pTHX_ shared_sv* ssv);
61
62/*
63 Shared SV
64
65 Shared SV is a structure for keeping the backend storage
66 of shared svs.
67
68*/
69
70/*
71
72 =head1 Shared SV Functions
73
74 =for apidoc sharedsv_init
75
76Saves a space for keeping SVs wider than an interpreter,
77currently only stores a pointer to the first interpreter.
78
79 =cut
80
81*/
82
83void
84Perl_sharedsv_init(pTHX)
85{
86 PerlInterpreter* old_context = PERL_GET_CONTEXT;
87 PL_sharedsv_space = perl_alloc();
88 perl_construct(PL_sharedsv_space);
89 PERL_SET_CONTEXT(old_context);
90 MUTEX_INIT(&PL_sharedsv_space_mutex);
91}
92
93/*
94 =for apidoc sharedsv_new
95
96Allocates a new shared sv struct, you must yourself create the SV/AV/HV.
97 =cut
98*/
99
100shared_sv *
101Perl_sharedsv_new(pTHX)
102{
103 shared_sv* ssv;
104 New(2555,ssv,1,shared_sv);
105 MUTEX_INIT(&ssv->mutex);
106 COND_INIT(&ssv->cond);
107 COND_INIT(&ssv->user_cond);
108 ssv->owner = 0;
109 ssv->locks = 0;
110 ssv->index = 0;
111 return ssv;
112}
113
114
115/*
116 =for apidoc sharedsv_find
117
118Tries to find if a given SV has a shared backend, either by
119looking at magic, or by checking if it is tied again threads::shared.
120
121 =cut
122*/
123
124shared_sv *
125Perl_sharedsv_find(pTHX_ SV* sv)
126{
127 /* does all it can to find a shared_sv struct, returns NULL otherwise */
128 shared_sv* ssv = NULL;
129 switch (SvTYPE(sv)) {
130 case SVt_PVMG:
131 case SVt_PVAV:
132 case SVt_PVHV: {
133 MAGIC* mg = mg_find(sv, PERL_MAGIC_ext);
134 if(mg) {
135 if(strcmp(mg->mg_ptr,"threads::shared"))
136 break;
137 ssv = INT2PTR(shared_sv *, SvIV(mg->mg_obj));
138 break;
139 }
140
141 mg = mg_find(sv,PERL_MAGIC_tied);
142 if(mg) {
143 SV* obj = SvTIED_obj(sv,mg);
144 if(sv_derived_from(obj, "threads::shared"))
145 ssv = INT2PTR(shared_sv *, SvIV(SvRV(obj)));
146 break;
147 }
148 }
149 }
150 return ssv;
151}
152
153/*
154 =for apidoc sharedsv_lock
155
156Recursive locks on a sharedsv.
157Locks are dynamically scoped at the level of the first lock.
158 =cut
159*/
160void
161Perl_sharedsv_lock(pTHX_ shared_sv* ssv)
162{
163 if(!ssv)
164 return;
165 MUTEX_LOCK(&ssv->mutex);
166 if(ssv->owner && ssv->owner == my_perl) {
167 ssv->locks++;
168 MUTEX_UNLOCK(&ssv->mutex);
169 return;
170 }
171 while(ssv->owner)
172 COND_WAIT(&ssv->cond,&ssv->mutex);
173 ssv->locks++;
174 ssv->owner = my_perl;
175 if(ssv->locks == 1)
176 SAVEDESTRUCTOR_X(Perl_sharedsv_unlock_scope,ssv);
177 MUTEX_UNLOCK(&ssv->mutex);
178}
179
180/*
181 =for apidoc sharedsv_unlock
182
183Recursively unlocks a shared sv.
184
185 =cut
186*/
187
188void
189Perl_sharedsv_unlock(pTHX_ shared_sv* ssv)
190{
191 MUTEX_LOCK(&ssv->mutex);
192 if(ssv->owner != my_perl) {
193 Perl_croak(aTHX_ "panic: Perl_sharedsv_unlock unlocking mutex that we don't own");
194 MUTEX_UNLOCK(&ssv->mutex);
195 return;
196 }
197
198 if(--ssv->locks == 0) {
199 ssv->owner = NULL;
200 COND_SIGNAL(&ssv->cond);
201 }
202 MUTEX_UNLOCK(&ssv->mutex);
203 }
204
205void
206Perl_sharedsv_unlock_scope(pTHX_ shared_sv* ssv)
207{
208 MUTEX_LOCK(&ssv->mutex);
209 if(ssv->owner != my_perl) {
210 MUTEX_UNLOCK(&ssv->mutex);
211 return;
212 }
213 ssv->locks = 0;
214 ssv->owner = NULL;
215 COND_SIGNAL(&ssv->cond);
216 MUTEX_UNLOCK(&ssv->mutex);
217}
218
219/*
220 =for apidoc sharedsv_thrcnt_inc
221
222Increments the threadcount of a sharedsv.
223 =cut
224*/
225void
226Perl_sharedsv_thrcnt_inc(pTHX_ shared_sv* ssv)
227{
228 SHAREDSvLOCK(ssv);
229 SvREFCNT_inc(ssv->sv);
230 SHAREDSvUNLOCK(ssv);
231}
232
233/*
234 =for apidoc sharedsv_thrcnt_dec
235
236Decrements the threadcount of a shared sv. When a threads frontend is freed
237this function should be called.
238
239 =cut
240*/
241
242void
243Perl_sharedsv_thrcnt_dec(pTHX_ shared_sv* ssv)
244{
245 SV* sv;
246 SHAREDSvLOCK(ssv);
247 sv = SHAREDSvGET(ssv);
248 if (SvREFCNT(sv) == 1) {
249 switch (SvTYPE(sv)) {
250 case SVt_RV:
251 if (SvROK(sv))
252 Perl_sharedsv_thrcnt_dec(aTHX_ INT2PTR(shared_sv *, SvIV(SvRV(sv))));
253 break;
254 case SVt_PVAV: {
255 SV **src_ary = AvARRAY((AV *)sv);
256 SSize_t items = AvFILLp((AV *)sv) + 1;
257
258 while (items-- > 0) {
259 if(SvTYPE(*src_ary))
260 Perl_sharedsv_thrcnt_dec(aTHX_ INT2PTR(shared_sv *, SvIV(*src_ary)));
261 src_ary++;
262 }
263 break;
264 }
265 case SVt_PVHV: {
266 HE *entry;
267 (void)hv_iterinit((HV *)sv);
268 while ((entry = hv_iternext((HV *)sv)))
269 Perl_sharedsv_thrcnt_dec(
270 aTHX_ INT2PTR(shared_sv *, SvIV(hv_iterval((HV *)sv, entry)))
271 );
272 break;
273 }
274 }
275 }
276 Perl_sv_free(PL_sharedsv_space,SHAREDSvGET(ssv));
277 SHAREDSvUNLOCK(ssv);
278}
279
280
409b1fd3 281MGVTBL svtable;
b050c948 282
ba14dd9a 283#define shared_sv_attach_sv(sv,shared) Perl_shared_sv_attach_sv(aTHX_ sv,shared)
284
68795e93 285SV* Perl_shared_sv_attach_sv (pTHX_ SV* sv, shared_sv* shared) {
b050c948 286 HV* shared_hv = get_hv("threads::shared::shared", FALSE);
170958c3 287 SV* id = newSViv(PTR2IV(shared));
b050c948 288 STRLEN length = sv_len(id);
289 SV* tiedobject;
290 SV** tiedobject_ = hv_fetch(shared_hv, SvPV(id,length), length, 0);
291 if(tiedobject_) {
292 tiedobject = (*tiedobject_);
0d76d117 293 if(sv) {
294 SvROK_on(sv);
295 SvRV(sv) = SvRV(tiedobject);
296 } else {
297 sv = newRV(SvRV(tiedobject));
298 }
b050c948 299 } else {
409b1fd3 300 switch(SvTYPE(SHAREDSvGET(shared))) {
938785a2 301 case SVt_PVAV: {
302 SV* weakref;
303 SV* obj_ref = newSViv(0);
304 SV* obj = newSVrv(obj_ref,"threads::shared::av");
305 AV* hv = newAV();
170958c3 306 sv_setiv(obj,PTR2IV(shared));
938785a2 307 weakref = newRV((SV*)hv);
308 sv = newRV_noinc((SV*)hv);
309 sv_rvweaken(weakref);
310 sv_magic((SV*) hv, obj_ref, PERL_MAGIC_tied, Nullch, 0);
311 hv_store(shared_hv, SvPV(id,length), length, weakref, 0);
312 Perl_sharedsv_thrcnt_inc(aTHX_ shared);
313 }
314 break;
315 case SVt_PVHV: {
316 SV* weakref;
317 SV* obj_ref = newSViv(0);
318 SV* obj = newSVrv(obj_ref,"threads::shared::hv");
319 HV* hv = newHV();
170958c3 320 sv_setiv(obj,PTR2IV(shared));
938785a2 321 weakref = newRV((SV*)hv);
322 sv = newRV_noinc((SV*)hv);
323 sv_rvweaken(weakref);
324 sv_magic((SV*) hv, obj_ref, PERL_MAGIC_tied, Nullch, 0);
325 hv_store(shared_hv, SvPV(id,length), length, weakref, 0);
326 Perl_sharedsv_thrcnt_inc(aTHX_ shared);
327 }
328 break;
409b1fd3 329 default: {
330 MAGIC* shared_magic;
331 SV* value = newSVsv(SHAREDSvGET(shared));
170958c3 332 SV* obj = newSViv(PTR2IV(shared));
409b1fd3 333 sv_magic(value, 0, PERL_MAGIC_ext, "threads::shared", 16);
334 shared_magic = mg_find(value, PERL_MAGIC_ext);
335 shared_magic->mg_virtual = &svtable;
170958c3 336 shared_magic->mg_obj = newSViv(PTR2IV(shared));
409b1fd3 337 shared_magic->mg_flags |= MGf_REFCOUNTED;
338 shared_magic->mg_private = 0;
339 SvMAGICAL_on(value);
340 sv = newRV_noinc(value);
341 value = newRV(value);
342 sv_rvweaken(value);
343 hv_store(shared_hv, SvPV(id,length),length, value, 0);
344 Perl_sharedsv_thrcnt_inc(aTHX_ shared);
345 }
346
347 }
b050c948 348 }
0d76d117 349 return sv;
b050c948 350}
351
352
353int shared_sv_fetch_mg (pTHX_ SV* sv, MAGIC *mg) {
170958c3 354 shared_sv* shared = INT2PTR(shared_sv*, SvIV(mg->mg_obj));
b050c948 355 SHAREDSvLOCK(shared);
55fc11ad 356 if(mg->mg_private != shared->index) {
357 if(SvROK(SHAREDSvGET(shared))) {
170958c3 358 shared_sv* target = INT2PTR(shared_sv*, SvIV(SvRV(SHAREDSvGET(shared))));
55fc11ad 359 shared_sv_attach_sv(sv, target);
360 } else {
361 sv_setsv(sv, SHAREDSvGET(shared));
362 }
363 mg->mg_private = shared->index;
b050c948 364 }
365 SHAREDSvUNLOCK(shared);
366
367 return 0;
368}
369
370int shared_sv_store_mg (pTHX_ SV* sv, MAGIC *mg) {
170958c3 371 shared_sv* shared = INT2PTR(shared_sv*, SvIV(mg->mg_obj));
b050c948 372 SHAREDSvLOCK(shared);
373 if(SvROK(SHAREDSvGET(shared)))
170958c3 374 Perl_sharedsv_thrcnt_dec(aTHX_ INT2PTR(shared_sv*, SvIV(SvRV(SHAREDSvGET(shared)))));
b050c948 375 if(SvROK(sv)) {
376 shared_sv* target = Perl_sharedsv_find(aTHX_ SvRV(sv));
377 if(!target) {
b050c948 378 sv_setsv(sv,SHAREDSvGET(shared));
68795e93 379 SHAREDSvUNLOCK(shared);
b050c948 380 Perl_croak(aTHX_ "You cannot assign a non shared reference to a shared scalar");
381 }
f70d29d4 382 SHAREDSvEDIT(shared);
b050c948 383 Perl_sv_free(PL_sharedsv_space,SHAREDSvGET(shared));
170958c3 384 SHAREDSvGET(shared) = newRV_noinc(newSViv(PTR2IV(target)));
b050c948 385 } else {
f70d29d4 386 SHAREDSvEDIT(shared);
387 sv_setsv(SHAREDSvGET(shared), sv);
b050c948 388 }
55fc11ad 389 shared->index++;
390 mg->mg_private = shared->index;
b050c948 391 SHAREDSvRELEASE(shared);
392 if(SvROK(SHAREDSvGET(shared)))
170958c3 393 Perl_sharedsv_thrcnt_inc(aTHX_ INT2PTR(shared_sv*, SvIV(SvRV(SHAREDSvGET(shared)))));
b050c948 394 SHAREDSvUNLOCK(shared);
395 return 0;
396}
397
ba14dd9a 398int
399shared_sv_destroy_mg (pTHX_ SV* sv, MAGIC *mg)
400{
170958c3 401 shared_sv* shared = INT2PTR(shared_sv*, SvIV(mg->mg_obj));
ba14dd9a 402 if (shared) {
409b1fd3 403 HV* shared_hv = get_hv("threads::shared::shared", FALSE);
170958c3 404 SV* id = newSViv(PTR2IV(shared));
409b1fd3 405 STRLEN length = sv_len(id);
406 hv_delete(shared_hv, SvPV(id,length), length,0);
ba14dd9a 407 Perl_sharedsv_thrcnt_dec(aTHX_ shared);
409b1fd3 408 }
ba14dd9a 409 return 0;
b050c948 410}
411
412MGVTBL svtable = {MEMBER_TO_FPTR(shared_sv_fetch_mg),
413 MEMBER_TO_FPTR(shared_sv_store_mg),
414 0,
415 0,
416 MEMBER_TO_FPTR(shared_sv_destroy_mg)
417};
418
419MODULE = threads::shared PACKAGE = threads::shared
420
421
ce127893 422PROTOTYPES: ENABLE
b050c948 423
424
425SV*
426ptr(ref)
427 SV* ref
428 CODE:
429 RETVAL = newSViv(SvIV(SvRV(ref)));
430 OUTPUT:
431 RETVAL
432
433
434SV*
435_thrcnt(ref)
436 SV* ref
437 CODE:
866fba46 438 shared_sv* shared;
439 if(SvROK(ref))
440 ref = SvRV(ref);
441 shared = Perl_sharedsv_find(aTHX, ref);
b050c948 442 if(!shared)
443 croak("thrcnt can only be used on shared values");
444 SHAREDSvLOCK(shared);
445 RETVAL = newSViv(SvREFCNT(SHAREDSvGET(shared)));
446 SHAREDSvUNLOCK(shared);
447 OUTPUT:
68795e93 448 RETVAL
b050c948 449
450
451void
cd8c9bf8 452thrcnt_inc(ref,perl)
b050c948 453 SV* ref
cd8c9bf8 454 SV* perl
b050c948 455 CODE:
456 shared_sv* shared;
170958c3 457 PerlInterpreter* origperl = INT2PTR(PerlInterpreter*, SvIV(perl));
cd8c9bf8 458 PerlInterpreter* oldperl = PERL_GET_CONTEXT;
68795e93 459 if(SvROK(ref))
b050c948 460 ref = SvRV(ref);
461 shared = Perl_sharedsv_find(aTHX, ref);
462 if(!shared)
463 croak("thrcnt can only be used on shared values");
cd8c9bf8 464 PERL_SET_CONTEXT(origperl);
b050c948 465 Perl_sharedsv_thrcnt_inc(aTHX_ shared);
cd8c9bf8 466 PERL_SET_CONTEXT(oldperl);
b050c948 467
866fba46 468void
469_thrcnt_dec(ref)
470 SV* ref
471 CODE:
170958c3 472 shared_sv* shared = INT2PTR(shared_sv*, SvIV(ref));
866fba46 473 if(!shared)
474 croak("thrcnt can only be used on shared values");
475 Perl_sharedsv_thrcnt_dec(aTHX_ shared);
476
68795e93 477void
6f942b98 478unlock_enabled(ref)
479 SV* ref
ce127893 480 PROTOTYPE: \[$@%]
6f942b98 481 CODE:
482 shared_sv* shared;
483 if(SvROK(ref))
484 ref = SvRV(ref);
485 shared = Perl_sharedsv_find(aTHX, ref);
486 if(!shared)
487 croak("unlock can only be used on shared values");
488 SHAREDSvUNLOCK(shared);
489
490void
491lock_enabled(ref)
492 SV* ref
6f942b98 493 CODE:
494 shared_sv* shared;
495 if(SvROK(ref))
496 ref = SvRV(ref);
497 shared = Perl_sharedsv_find(aTHX, ref);
498 if(!shared)
499 croak("lock can only be used on shared values");
500 SHAREDSvLOCK(shared);
501
502
503void
504cond_wait_enabled(ref)
505 SV* ref
ce127893 506 PROTOTYPE: \[$@%]
6f942b98 507 CODE:
508 shared_sv* shared;
509 int locks;
510 if(SvROK(ref))
511 ref = SvRV(ref);
512 shared = Perl_sharedsv_find(aTHX_ ref);
513 if(!shared)
514 croak("cond_wait can only be used on shared values");
515 if(shared->owner != PERL_GET_CONTEXT)
516 croak("You need a lock before you can cond_wait");
517 MUTEX_LOCK(&shared->mutex);
518 shared->owner = NULL;
519 locks = shared->locks = 0;
520 COND_WAIT(&shared->user_cond, &shared->mutex);
521 shared->owner = PERL_GET_CONTEXT;
522 shared->locks = locks;
a6b94e59 523 MUTEX_UNLOCK(&shared->mutex);
6f942b98 524
525void cond_signal_enabled(ref)
526 SV* ref
ce127893 527 PROTOTYPE: \[$@%]
6f942b98 528 CODE:
529 shared_sv* shared;
530 if(SvROK(ref))
531 ref = SvRV(ref);
532 shared = Perl_sharedsv_find(aTHX_ ref);
533 if(!shared)
534 croak("cond_signal can only be used on shared values");
535 COND_SIGNAL(&shared->user_cond);
536
537
538void cond_broadcast_enabled(ref)
539 SV* ref
ce127893 540 PROTOTYPE: \[$@%]
6f942b98 541 CODE:
542 shared_sv* shared;
543 if(SvROK(ref))
544 ref = SvRV(ref);
545 shared = Perl_sharedsv_find(aTHX_ ref);
546 if(!shared)
547 croak("cond_broadcast can only be used on shared values");
548 COND_BROADCAST(&shared->user_cond);
b050c948 549
550MODULE = threads::shared PACKAGE = threads::shared::sv
551
552SV*
553new(class, value)
554 SV* class
555 SV* value
556 CODE:
557 shared_sv* shared = Perl_sharedsv_new(aTHX);
558 MAGIC* shared_magic;
170958c3 559 SV* obj = newSViv(PTR2IV(shared));
b050c948 560 SHAREDSvEDIT(shared);
561 SHAREDSvGET(shared) = newSVsv(value);
562 SHAREDSvRELEASE(shared);
563 sv_magic(value, 0, PERL_MAGIC_ext, "threads::shared", 16);
564 shared_magic = mg_find(value, PERL_MAGIC_ext);
565 shared_magic->mg_virtual = &svtable;
170958c3 566 shared_magic->mg_obj = newSViv(PTR2IV(shared));
b050c948 567 shared_magic->mg_flags |= MGf_REFCOUNTED;
55fc11ad 568 shared_magic->mg_private = 0;
b050c948 569 SvMAGICAL_on(value);
570 RETVAL = obj;
571 OUTPUT:
572 RETVAL
573
574
aaf3876d 575MODULE = threads::shared PACKAGE = threads::shared::av
576
68795e93 577SV*
aaf3876d 578new(class, value)
579 SV* class
580 SV* value
581 CODE:
582 shared_sv* shared = Perl_sharedsv_new(aTHX);
170958c3 583 SV* obj = newSViv(PTR2IV(shared));
aaf3876d 584 SHAREDSvEDIT(shared);
585 SHAREDSvGET(shared) = (SV*) newAV();
586 SHAREDSvRELEASE(shared);
587 RETVAL = obj;
588 OUTPUT:
589 RETVAL
590
591void
592STORE(self, index, value)
593 SV* self
594 SV* index
595 SV* value
68795e93 596 CODE:
170958c3 597 shared_sv* shared = INT2PTR(shared_sv*, SvIV(SvRV(self)));
aaf3876d 598 shared_sv* slot;
599 SV* aentry;
600 SV** aentry_;
79a24c1c 601 if(SvROK(value)) {
602 shared_sv* target = Perl_sharedsv_find(aTHX_ SvRV(value));
603 if(!target) {
d1be9408 604 Perl_croak(aTHX_ "You cannot assign a non shared reference to a shared array");
79a24c1c 605 }
170958c3 606 value = newRV_noinc(newSViv(PTR2IV(target)));
79a24c1c 607 }
aaf3876d 608 SHAREDSvLOCK(shared);
609 aentry_ = av_fetch((AV*) SHAREDSvGET(shared), SvIV(index), 0);
610 if(aentry_ && SvIV((*aentry_))) {
611 aentry = (*aentry_);
170958c3 612 slot = INT2PTR(shared_sv*, SvIV(aentry));
aaf3876d 613 if(SvROK(SHAREDSvGET(slot)))
170958c3 614 Perl_sharedsv_thrcnt_dec(aTHX_ INT2PTR(shared_sv*, SvIV(SvRV(SHAREDSvGET(slot)))));
aaf3876d 615 SHAREDSvEDIT(slot);
616 sv_setsv(SHAREDSvGET(slot), value);
617 SHAREDSvRELEASE(slot);
618 } else {
619 slot = Perl_sharedsv_new(aTHX);
620 SHAREDSvEDIT(shared);
621 SHAREDSvGET(slot) = newSVsv(value);
170958c3 622 aentry = newSViv(PTR2IV(slot));
aaf3876d 623 av_store((AV*) SHAREDSvGET(shared), SvIV(index), aentry);
624 SHAREDSvRELEASE(shared);
625 }
79a24c1c 626 if(SvROK(SHAREDSvGET(slot)))
170958c3 627 Perl_sharedsv_thrcnt_inc(aTHX_ INT2PTR(shared_sv*, SvIV(SvRV(SHAREDSvGET(slot)))));
79a24c1c 628
aaf3876d 629 SHAREDSvUNLOCK(shared);
630
631SV*
632FETCH(self, index)
633 SV* self
634 SV* index
635 CODE:
170958c3 636 shared_sv* shared = INT2PTR(shared_sv*, SvIV(SvRV(self)));
aaf3876d 637 shared_sv* slot;
638 SV* aentry;
639 SV** aentry_;
640 SV* retval;
641 SHAREDSvLOCK(shared);
642 aentry_ = av_fetch((AV*) SHAREDSvGET(shared), SvIV(index),0);
643 if(aentry_) {
644 aentry = (*aentry_);
645 if(SvTYPE(aentry) == SVt_NULL) {
646 retval = &PL_sv_undef;
647 } else {
170958c3 648 slot = INT2PTR(shared_sv*, SvIV(aentry));
79a24c1c 649 if(SvROK(SHAREDSvGET(slot))) {
170958c3 650 shared_sv* target = INT2PTR(shared_sv*, SvIV(SvRV(SHAREDSvGET(slot))));
68795e93 651 retval = Perl_shared_sv_attach_sv(aTHX_ NULL,target);
79a24c1c 652 } else {
653 retval = newSVsv(SHAREDSvGET(slot));
654 }
aaf3876d 655 }
656 } else {
657 retval = &PL_sv_undef;
658 }
659 SHAREDSvUNLOCK(shared);
660 RETVAL = retval;
661 OUTPUT:
662 RETVAL
663
664void
665PUSH(self, ...)
666 SV* self
667 CODE:
170958c3 668 shared_sv* shared = INT2PTR(shared_sv*, SvIV(SvRV(self)));
aaf3876d 669 int i;
670 SHAREDSvLOCK(shared);
671 for(i = 1; i < items; i++) {
672 shared_sv* slot = Perl_sharedsv_new(aTHX);
673 SV* tmp = ST(i);
79a24c1c 674 if(SvROK(tmp)) {
675 shared_sv* target = Perl_sharedsv_find(aTHX_ SvRV(tmp));
676 if(!target) {
d1be9408 677 Perl_croak(aTHX_ "You cannot assign a non shared reference to a shared array");
79a24c1c 678 }
170958c3 679 tmp = newRV_noinc(newSViv(PTR2IV(target)));
79a24c1c 680 }
aaf3876d 681 SHAREDSvEDIT(slot);
682 SHAREDSvGET(slot) = newSVsv(tmp);
170958c3 683 av_push((AV*) SHAREDSvGET(shared), newSViv(PTR2IV(slot)));
aaf3876d 684 SHAREDSvRELEASE(slot);
79a24c1c 685 if(SvROK(SHAREDSvGET(slot)))
170958c3 686 Perl_sharedsv_thrcnt_inc(aTHX_ INT2PTR(shared_sv*, SvIV(SvRV(SHAREDSvGET(slot)))));
aaf3876d 687 }
688 SHAREDSvUNLOCK(shared);
689
690void
691UNSHIFT(self, ...)
692 SV* self
693 CODE:
170958c3 694 shared_sv* shared = INT2PTR(shared_sv*, SvIV(SvRV(self)));
aaf3876d 695 int i;
696 SHAREDSvLOCK(shared);
697 SHAREDSvEDIT(shared);
698 av_unshift((AV*)SHAREDSvGET(shared), items - 1);
699 SHAREDSvRELEASE(shared);
700 for(i = 1; i < items; i++) {
701 shared_sv* slot = Perl_sharedsv_new(aTHX);
702 SV* tmp = ST(i);
79a24c1c 703 if(SvROK(tmp)) {
704 shared_sv* target = Perl_sharedsv_find(aTHX_ SvRV(tmp));
705 if(!target) {
d1be9408 706 Perl_croak(aTHX_ "You cannot assign a non shared reference to a shared array");
79a24c1c 707 }
170958c3 708 tmp = newRV_noinc(newSViv(PTR2IV(target)));
79a24c1c 709 }
aaf3876d 710 SHAREDSvEDIT(slot);
711 SHAREDSvGET(slot) = newSVsv(tmp);
170958c3 712 av_store((AV*) SHAREDSvGET(shared), i - 1, newSViv(PTR2IV(slot)));
aaf3876d 713 SHAREDSvRELEASE(slot);
79a24c1c 714 if(SvROK(SHAREDSvGET(slot)))
170958c3 715 Perl_sharedsv_thrcnt_inc(aTHX_ INT2PTR(shared_sv*, SvIV(SvRV(SHAREDSvGET(slot)))));
aaf3876d 716 }
717 SHAREDSvUNLOCK(shared);
718
719SV*
720POP(self)
721 SV* self
722 CODE:
170958c3 723 shared_sv* shared = INT2PTR(shared_sv*, SvIV(SvRV(self)));
aaf3876d 724 shared_sv* slot;
725 SV* retval;
726 SHAREDSvLOCK(shared);
727 SHAREDSvEDIT(shared);
728 retval = av_pop((AV*)SHAREDSvGET(shared));
729 SHAREDSvRELEASE(shared);
730 if(retval && SvIV(retval)) {
170958c3 731 slot = INT2PTR(shared_sv*, SvIV(retval));
79a24c1c 732 if(SvROK(SHAREDSvGET(slot))) {
170958c3 733 shared_sv* target = INT2PTR(shared_sv*, SvIV(SvRV(SHAREDSvGET(slot))));
68795e93 734 retval = Perl_shared_sv_attach_sv(aTHX_ NULL,target);
79a24c1c 735 } else {
736 retval = newSVsv(SHAREDSvGET(slot));
737 }
aaf3876d 738 Perl_sharedsv_thrcnt_dec(aTHX_ slot);
739 } else {
740 retval = &PL_sv_undef;
741 }
742 SHAREDSvUNLOCK(shared);
743 RETVAL = retval;
744 OUTPUT:
745 RETVAL
746
747
748SV*
749SHIFT(self)
750 SV* self
751 CODE:
170958c3 752 shared_sv* shared = INT2PTR(shared_sv*, SvIV(SvRV(self)));
aaf3876d 753 shared_sv* slot;
754 SV* retval;
755 SHAREDSvLOCK(shared);
756 SHAREDSvEDIT(shared);
757 retval = av_shift((AV*)SHAREDSvGET(shared));
758 SHAREDSvRELEASE(shared);
759 if(retval && SvIV(retval)) {
170958c3 760 slot = INT2PTR(shared_sv*, SvIV(retval));
79a24c1c 761 if(SvROK(SHAREDSvGET(slot))) {
170958c3 762 shared_sv* target = INT2PTR(shared_sv*, SvIV(SvRV(SHAREDSvGET(slot))));
68795e93 763 retval = Perl_shared_sv_attach_sv(aTHX_ NULL,target);
79a24c1c 764 } else {
765 retval = newSVsv(SHAREDSvGET(slot));
766 }
aaf3876d 767 Perl_sharedsv_thrcnt_dec(aTHX_ slot);
768 } else {
769 retval = &PL_sv_undef;
770 }
771 SHAREDSvUNLOCK(shared);
772 RETVAL = retval;
773 OUTPUT:
774 RETVAL
775
776void
777CLEAR(self)
778 SV* self
779 CODE:
170958c3 780 shared_sv* shared = INT2PTR(shared_sv*, SvIV(SvRV(self)));
aaf3876d 781 shared_sv* slot;
782 SV** svp;
783 I32 i;
784 SHAREDSvLOCK(shared);
785 svp = AvARRAY((AV*)SHAREDSvGET(shared));
786 i = AvFILLp((AV*)SHAREDSvGET(shared));
787 while ( i >= 0) {
788 if(SvIV(svp[i])) {
170958c3 789 Perl_sharedsv_thrcnt_dec(aTHX_ INT2PTR(shared_sv*, SvIV(svp[i])));
aaf3876d 790 }
791 i--;
792 }
793 SHAREDSvEDIT(shared);
794 av_clear((AV*)SHAREDSvGET(shared));
795 SHAREDSvRELEASE(shared);
796 SHAREDSvUNLOCK(shared);
797
798void
799EXTEND(self, count)
800 SV* self
801 SV* count
802 CODE:
170958c3 803 shared_sv* shared = INT2PTR(shared_sv*, SvIV(SvRV(self)));
aaf3876d 804 SHAREDSvEDIT(shared);
805 av_extend((AV*)SHAREDSvGET(shared), (I32) SvIV(count));
806 SHAREDSvRELEASE(shared);
807
808
809
810
811SV*
812EXISTS(self, index)
813 SV* self
814 SV* index
815 CODE:
170958c3 816 shared_sv* shared = INT2PTR(shared_sv*, SvIV(SvRV(self)));
aaf3876d 817 I32 exists;
818 SHAREDSvLOCK(shared);
819 exists = av_exists((AV*) SHAREDSvGET(shared), (I32) SvIV(index));
820 if(exists) {
821 RETVAL = &PL_sv_yes;
822 } else {
823 RETVAL = &PL_sv_no;
824 }
825 SHAREDSvUNLOCK(shared);
826
827void
828STORESIZE(self,count)
829 SV* self
830 SV* count
831 CODE:
170958c3 832 shared_sv* shared = INT2PTR(shared_sv*, SvIV(SvRV(self)));
aaf3876d 833 SHAREDSvEDIT(shared);
834 av_fill((AV*) SHAREDSvGET(shared), (I32) SvIV(count));
835 SHAREDSvRELEASE(shared);
836
837SV*
838FETCHSIZE(self)
839 SV* self
840 CODE:
170958c3 841 shared_sv* shared = INT2PTR(shared_sv*, SvIV(SvRV(self)));
aaf3876d 842 SHAREDSvLOCK(shared);
843 RETVAL = newSViv(av_len((AV*) SHAREDSvGET(shared)) + 1);
844 SHAREDSvUNLOCK(shared);
845 OUTPUT:
846 RETVAL
847
848SV*
849DELETE(self,index)
850 SV* self
851 SV* index
852 CODE:
170958c3 853 shared_sv* shared = INT2PTR(shared_sv*, SvIV(SvRV(self)));
aaf3876d 854 shared_sv* slot;
855 SHAREDSvLOCK(shared);
856 if(av_exists((AV*) SHAREDSvGET(shared), (I32) SvIV(index))) {
857 SV* tmp;
858 SHAREDSvEDIT(shared);
859 tmp = av_delete((AV*)SHAREDSvGET(shared), (I32) SvIV(index),0);
860 SHAREDSvRELEASE(shared);
861 if(SvIV(tmp)) {
170958c3 862 slot = INT2PTR(shared_sv*, SvIV(tmp));
79a24c1c 863 if(SvROK(SHAREDSvGET(slot))) {
170958c3 864 shared_sv* target = INT2PTR(shared_sv*, SvIV(SvRV(SHAREDSvGET(slot))));
68795e93 865 RETVAL = Perl_shared_sv_attach_sv(aTHX_ NULL,target);
79a24c1c 866 } else {
867 RETVAL = newSVsv(SHAREDSvGET(slot));
868 }
68795e93 869 Perl_sharedsv_thrcnt_dec(aTHX_ slot);
aaf3876d 870 } else {
871 RETVAL = &PL_sv_undef;
68795e93 872 }
aaf3876d 873 } else {
874 RETVAL = &PL_sv_undef;
875 }
876 SHAREDSvUNLOCK(shared);
877 OUTPUT:
878 RETVAL
879
880AV*
881SPLICE(self, offset, length, ...)
882 SV* self
883 SV* offset
884 SV* length
885 CODE:
886 croak("Splice is not implmented for shared arrays");
887
8669ce85 888MODULE = threads::shared PACKAGE = threads::shared::hv
aaf3876d 889
68795e93 890SV*
8669ce85 891new(class, value)
892 SV* class
893 SV* value
894 CODE:
895 shared_sv* shared = Perl_sharedsv_new(aTHX);
170958c3 896 SV* obj = newSViv(PTR2IV(shared));
8669ce85 897 SHAREDSvEDIT(shared);
898 SHAREDSvGET(shared) = (SV*) newHV();
899 SHAREDSvRELEASE(shared);
900 RETVAL = obj;
901 OUTPUT:
902 RETVAL
903
904void
905STORE(self, key, value)
906 SV* self
907 SV* key
908 SV* value
909 CODE:
170958c3 910 shared_sv* shared = INT2PTR(shared_sv*, SvIV(SvRV(self)));
8669ce85 911 shared_sv* slot;
912 SV* hentry;
913 SV** hentry_;
914 STRLEN len;
915 char* ckey = SvPV(key, len);
409b1fd3 916 SHAREDSvLOCK(shared);
0d76d117 917 if(SvROK(value)) {
918 shared_sv* target = Perl_sharedsv_find(aTHX_ SvRV(value));
919 if(!target) {
920 Perl_croak(aTHX_ "You cannot assign a non shared reference to a shared hash");
921 }
409b1fd3 922 SHAREDSvEDIT(shared);
170958c3 923 value = newRV_noinc(newSViv(PTR2IV(target)));
409b1fd3 924 SHAREDSvRELEASE(shared);
0d76d117 925 }
8669ce85 926 hentry_ = hv_fetch((HV*) SHAREDSvGET(shared), ckey, len, 0);
927 if(hentry_ && SvIV((*hentry_))) {
928 hentry = (*hentry_);
170958c3 929 slot = INT2PTR(shared_sv*, SvIV(hentry));
8669ce85 930 if(SvROK(SHAREDSvGET(slot)))
170958c3 931 Perl_sharedsv_thrcnt_dec(aTHX_ INT2PTR(shared_sv*, SvIV(SvRV(SHAREDSvGET(slot)))));
8669ce85 932 SHAREDSvEDIT(slot);
933 sv_setsv(SHAREDSvGET(slot), value);
934 SHAREDSvRELEASE(slot);
935 } else {
936 slot = Perl_sharedsv_new(aTHX);
937 SHAREDSvEDIT(shared);
938 SHAREDSvGET(slot) = newSVsv(value);
170958c3 939 hentry = newSViv(PTR2IV(slot));
8669ce85 940 hv_store((HV*) SHAREDSvGET(shared), ckey,len , hentry, 0);
941 SHAREDSvRELEASE(shared);
942 }
0d76d117 943 if(SvROK(SHAREDSvGET(slot)))
170958c3 944 Perl_sharedsv_thrcnt_inc(aTHX_ INT2PTR(shared_sv*, SvIV(SvRV(SHAREDSvGET(slot)))));
8669ce85 945 SHAREDSvUNLOCK(shared);
946
947
948SV*
949FETCH(self, key)
950 SV* self
951 SV* key
952 CODE:
170958c3 953 shared_sv* shared = INT2PTR(shared_sv*, SvIV(SvRV(self)));
8669ce85 954 shared_sv* slot;
955 SV* hentry;
956 SV** hentry_;
957 SV* retval;
958 STRLEN len;
959 char* ckey = SvPV(key, len);
960 SHAREDSvLOCK(shared);
961 hentry_ = hv_fetch((HV*) SHAREDSvGET(shared), ckey, len,0);
962 if(hentry_) {
963 hentry = (*hentry_);
964 if(SvTYPE(hentry) == SVt_NULL) {
965 retval = &PL_sv_undef;
966 } else {
170958c3 967 slot = INT2PTR(shared_sv*, SvIV(hentry));
0d76d117 968 if(SvROK(SHAREDSvGET(slot))) {
170958c3 969 shared_sv* target = INT2PTR(shared_sv*, SvIV(SvRV(SHAREDSvGET(slot))));
68795e93 970 retval = Perl_shared_sv_attach_sv(aTHX_ NULL, target);
0d76d117 971 } else {
972 retval = newSVsv(SHAREDSvGET(slot));
973 }
8669ce85 974 }
975 } else {
976 retval = &PL_sv_undef;
977 }
978 SHAREDSvUNLOCK(shared);
979 RETVAL = retval;
980 OUTPUT:
981 RETVAL
982
983void
984CLEAR(self)
985 SV* self
986 CODE:
170958c3 987 shared_sv* shared = INT2PTR(shared_sv*, SvIV(SvRV(self)));
8669ce85 988 shared_sv* slot;
989 HE* entry;
990 SHAREDSvLOCK(shared);
991 Perl_hv_iterinit(PL_sharedsv_space, (HV*) SHAREDSvGET(shared));
992 entry = Perl_hv_iternext(PL_sharedsv_space, (HV*) SHAREDSvGET(shared));
993 while(entry) {
170958c3 994 slot = INT2PTR(shared_sv*, SvIV(Perl_hv_iterval(PL_sharedsv_space, (HV*) SHAREDSvGET(shared), entry)));
8669ce85 995 Perl_sharedsv_thrcnt_dec(aTHX_ slot);
996 entry = Perl_hv_iternext(PL_sharedsv_space,(HV*) SHAREDSvGET(shared));
997 }
998 SHAREDSvEDIT(shared);
999 hv_clear((HV*) SHAREDSvGET(shared));
1000 SHAREDSvRELEASE(shared);
1001 SHAREDSvUNLOCK(shared);
1002
1003SV*
1004FIRSTKEY(self)
1005 SV* self
1006 CODE:
170958c3 1007 shared_sv* shared = INT2PTR(shared_sv*, SvIV(SvRV(self)));
8669ce85 1008 char* key = NULL;
1009 I32 len;
1010 HE* entry;
1011 SHAREDSvLOCK(shared);
1012 Perl_hv_iterinit(PL_sharedsv_space, (HV*) SHAREDSvGET(shared));
1013 entry = Perl_hv_iternext(PL_sharedsv_space, (HV*) SHAREDSvGET(shared));
1014 if(entry) {
1015 key = Perl_hv_iterkey(PL_sharedsv_space, entry,&len);
1016 RETVAL = newSVpv(key, len);
1017 } else {
1018 RETVAL = &PL_sv_undef;
1019 }
1020 SHAREDSvUNLOCK(shared);
1021 OUTPUT:
1022 RETVAL
1023
1024
1025SV*
1026NEXTKEY(self, oldkey)
1027 SV* self
1028 SV* oldkey
1029 CODE:
170958c3 1030 shared_sv* shared = INT2PTR(shared_sv*, SvIV(SvRV(self)));
8669ce85 1031 char* key = NULL;
1032 I32 len;
1033 HE* entry;
1034 SHAREDSvLOCK(shared);
1035 entry = Perl_hv_iternext(PL_sharedsv_space, (HV*) SHAREDSvGET(shared));
1036 if(entry) {
1037 key = Perl_hv_iterkey(PL_sharedsv_space, entry,&len);
1038 RETVAL = newSVpv(key, len);
1039 } else {
1040 RETVAL = &PL_sv_undef;
1041 }
1042 SHAREDSvUNLOCK(shared);
1043 OUTPUT:
1044 RETVAL
1045
1046
1047SV*
1048EXISTS(self, key)
1049 SV* self
1050 SV* key
1051 CODE:
170958c3 1052 shared_sv* shared = INT2PTR(shared_sv*, SvIV(SvRV(self)));
8669ce85 1053 STRLEN len;
1054 char* ckey = SvPV(key, len);
1055 SHAREDSvLOCK(shared);
1056 if(hv_exists((HV*)SHAREDSvGET(shared), ckey, len)) {
1057 RETVAL = &PL_sv_yes;
1058 } else {
1059 RETVAL = &PL_sv_no;
1060 }
1061 SHAREDSvUNLOCK(shared);
1062 OUTPUT:
1063 RETVAL
1064
1065SV*
1066DELETE(self, key)
1067 SV* self
1068 SV* key
1069 CODE:
170958c3 1070 shared_sv* shared = INT2PTR(shared_sv*, SvIV(SvRV(self)));
8669ce85 1071 shared_sv* slot;
1072 STRLEN len;
1073 char* ckey = SvPV(key, len);
1074 SV* tmp;
1075 SHAREDSvLOCK(shared);
1076 SHAREDSvEDIT(shared);
1077 tmp = hv_delete((HV*) SHAREDSvGET(shared), ckey, len,0);
1078 SHAREDSvRELEASE(shared);
1079 if(tmp) {
170958c3 1080 slot = INT2PTR(shared_sv*, SvIV(tmp));
0d76d117 1081 if(SvROK(SHAREDSvGET(slot))) {
170958c3 1082 shared_sv* target = INT2PTR(shared_sv*, SvIV(SvRV(SHAREDSvGET(slot))));
68795e93 1083 RETVAL = Perl_shared_sv_attach_sv(aTHX_ NULL, target);
0d76d117 1084 } else {
1085 RETVAL = newSVsv(SHAREDSvGET(slot));
1086 }
8669ce85 1087 Perl_sharedsv_thrcnt_dec(aTHX_ slot);
1088 } else {
1089 RETVAL = &PL_sv_undef;
1090 }
1091 SHAREDSvUNLOCK(shared);
1092 OUTPUT:
1093 RETVAL
68795e93 1094
1095BOOT:
1096{
1097 Perl_sharedsv_init(aTHX);
1098}
Unnamed repository; edit this file to name it for gitweb.