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