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); |
170958c3 |
10 | SV* id = newSViv(PTR2IV(shared)); |
b050c948 |
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(); |
170958c3 |
29 | sv_setiv(obj,PTR2IV(shared)); |
938785a2 |
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 |
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)); |
170958c3 |
55 | SV* obj = newSViv(PTR2IV(shared)); |
409b1fd3 |
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 |
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) { |
170958c3 |
77 | shared_sv* shared = INT2PTR(shared_sv*, SvIV(mg->mg_obj)); |
b050c948 |
78 | SHAREDSvLOCK(shared); |
55fc11ad |
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 |
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) { |
170958c3 |
94 | shared_sv* shared = INT2PTR(shared_sv*, SvIV(mg->mg_obj)); |
b050c948 |
95 | SHAREDSvLOCK(shared); |
96 | if(SvROK(SHAREDSvGET(shared))) |
170958c3 |
97 | Perl_sharedsv_thrcnt_dec(aTHX_ INT2PTR(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)); |
170958c3 |
107 | SHAREDSvGET(shared) = newRV_noinc(newSViv(PTR2IV(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))) |
170958c3 |
116 | Perl_sharedsv_thrcnt_inc(aTHX_ INT2PTR(shared_sv*, SvIV(SvRV(SHAREDSvGET(shared))))); |
b050c948 |
117 | SHAREDSvUNLOCK(shared); |
118 | return 0; |
119 | } |
120 | |
121 | int shared_sv_destroy_mg (pTHX_ SV* sv, MAGIC *mg) { |
170958c3 |
122 | shared_sv* shared = INT2PTR(shared_sv*, SvIV(mg->mg_obj)); |
b050c948 |
123 | if(!shared) |
124 | return 0; |
409b1fd3 |
125 | { |
126 | HV* shared_hv = get_hv("threads::shared::shared", FALSE); |
170958c3 |
127 | SV* id = newSViv(PTR2IV(shared)); |
409b1fd3 |
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 | |
ce127893 |
144 | PROTOTYPES: ENABLE |
b050c948 |
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 |
cd8c9bf8 |
174 | thrcnt_inc(ref,perl) |
b050c948 |
175 | SV* ref |
cd8c9bf8 |
176 | SV* perl |
b050c948 |
177 | CODE: |
178 | shared_sv* shared; |
170958c3 |
179 | PerlInterpreter* origperl = INT2PTR(PerlInterpreter*, SvIV(perl)); |
cd8c9bf8 |
180 | PerlInterpreter* oldperl = PERL_GET_CONTEXT; |
b050c948 |
181 | if(SvROK(ref)) |
182 | ref = SvRV(ref); |
183 | shared = Perl_sharedsv_find(aTHX, ref); |
184 | if(!shared) |
185 | croak("thrcnt can only be used on shared values"); |
cd8c9bf8 |
186 | PERL_SET_CONTEXT(origperl); |
b050c948 |
187 | Perl_sharedsv_thrcnt_inc(aTHX_ shared); |
cd8c9bf8 |
188 | PERL_SET_CONTEXT(oldperl); |
b050c948 |
189 | |
866fba46 |
190 | void |
191 | _thrcnt_dec(ref) |
192 | SV* ref |
193 | CODE: |
170958c3 |
194 | shared_sv* shared = INT2PTR(shared_sv*, SvIV(ref)); |
866fba46 |
195 | if(!shared) |
196 | croak("thrcnt can only be used on shared values"); |
197 | Perl_sharedsv_thrcnt_dec(aTHX_ shared); |
198 | |
6f942b98 |
199 | void |
200 | unlock_enabled(ref) |
201 | SV* ref |
ce127893 |
202 | PROTOTYPE: \[$@%] |
6f942b98 |
203 | CODE: |
204 | shared_sv* shared; |
205 | if(SvROK(ref)) |
206 | ref = SvRV(ref); |
207 | shared = Perl_sharedsv_find(aTHX, ref); |
208 | if(!shared) |
209 | croak("unlock can only be used on shared values"); |
210 | SHAREDSvUNLOCK(shared); |
211 | |
212 | void |
213 | lock_enabled(ref) |
214 | SV* ref |
6f942b98 |
215 | CODE: |
216 | shared_sv* shared; |
217 | if(SvROK(ref)) |
218 | ref = SvRV(ref); |
219 | shared = Perl_sharedsv_find(aTHX, ref); |
220 | if(!shared) |
221 | croak("lock can only be used on shared values"); |
222 | SHAREDSvLOCK(shared); |
223 | |
224 | |
225 | void |
226 | cond_wait_enabled(ref) |
227 | SV* ref |
ce127893 |
228 | PROTOTYPE: \[$@%] |
6f942b98 |
229 | CODE: |
230 | shared_sv* shared; |
231 | int locks; |
232 | if(SvROK(ref)) |
233 | ref = SvRV(ref); |
234 | shared = Perl_sharedsv_find(aTHX_ ref); |
235 | if(!shared) |
236 | croak("cond_wait can only be used on shared values"); |
237 | if(shared->owner != PERL_GET_CONTEXT) |
238 | croak("You need a lock before you can cond_wait"); |
239 | MUTEX_LOCK(&shared->mutex); |
240 | shared->owner = NULL; |
241 | locks = shared->locks = 0; |
242 | COND_WAIT(&shared->user_cond, &shared->mutex); |
243 | shared->owner = PERL_GET_CONTEXT; |
244 | shared->locks = locks; |
a6b94e59 |
245 | MUTEX_UNLOCK(&shared->mutex); |
6f942b98 |
246 | |
247 | void cond_signal_enabled(ref) |
248 | SV* ref |
ce127893 |
249 | PROTOTYPE: \[$@%] |
6f942b98 |
250 | CODE: |
251 | shared_sv* shared; |
252 | if(SvROK(ref)) |
253 | ref = SvRV(ref); |
254 | shared = Perl_sharedsv_find(aTHX_ ref); |
255 | if(!shared) |
256 | croak("cond_signal can only be used on shared values"); |
257 | COND_SIGNAL(&shared->user_cond); |
258 | |
259 | |
260 | void cond_broadcast_enabled(ref) |
261 | SV* ref |
ce127893 |
262 | PROTOTYPE: \[$@%] |
6f942b98 |
263 | CODE: |
264 | shared_sv* shared; |
265 | if(SvROK(ref)) |
266 | ref = SvRV(ref); |
267 | shared = Perl_sharedsv_find(aTHX_ ref); |
268 | if(!shared) |
269 | croak("cond_broadcast can only be used on shared values"); |
270 | COND_BROADCAST(&shared->user_cond); |
b050c948 |
271 | |
272 | MODULE = threads::shared PACKAGE = threads::shared::sv |
273 | |
274 | SV* |
275 | new(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 |
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 |
291 | SvMAGICAL_on(value); |
292 | RETVAL = obj; |
293 | OUTPUT: |
294 | RETVAL |
295 | |
296 | |
aaf3876d |
297 | MODULE = threads::shared PACKAGE = threads::shared::av |
298 | |
299 | SV* |
300 | new(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 |
306 | SHAREDSvEDIT(shared); |
307 | SHAREDSvGET(shared) = (SV*) newAV(); |
308 | SHAREDSvRELEASE(shared); |
309 | RETVAL = obj; |
310 | OUTPUT: |
311 | RETVAL |
312 | |
313 | void |
314 | STORE(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 |
320 | shared_sv* slot; |
321 | SV* aentry; |
322 | SV** aentry_; |
79a24c1c |
323 | if(SvROK(value)) { |
324 | shared_sv* target = Perl_sharedsv_find(aTHX_ SvRV(value)); |
325 | if(!target) { |
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 |
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 |
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 |
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 |
351 | SHAREDSvUNLOCK(shared); |
352 | |
353 | SV* |
354 | FETCH(self, index) |
355 | SV* self |
356 | SV* index |
357 | CODE: |
170958c3 |
358 | shared_sv* shared = INT2PTR(shared_sv*, SvIV(SvRV(self))); |
aaf3876d |
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 |
373 | retval = shared_sv_attach_sv(NULL,target); |
374 | } else { |
375 | retval = newSVsv(SHAREDSvGET(slot)); |
376 | } |
aaf3876d |
377 | } |
378 | } else { |
379 | retval = &PL_sv_undef; |
380 | } |
381 | SHAREDSvUNLOCK(shared); |
382 | RETVAL = retval; |
383 | OUTPUT: |
384 | RETVAL |
385 | |
386 | void |
387 | PUSH(self, ...) |
388 | SV* self |
389 | CODE: |
170958c3 |
390 | shared_sv* shared = INT2PTR(shared_sv*, SvIV(SvRV(self))); |
aaf3876d |
391 | int i; |
392 | SHAREDSvLOCK(shared); |
393 | for(i = 1; i < items; i++) { |
394 | shared_sv* slot = Perl_sharedsv_new(aTHX); |
395 | SV* tmp = ST(i); |
79a24c1c |
396 | if(SvROK(tmp)) { |
397 | shared_sv* target = Perl_sharedsv_find(aTHX_ SvRV(tmp)); |
398 | if(!target) { |
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 |
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 |
409 | } |
410 | SHAREDSvUNLOCK(shared); |
411 | |
412 | void |
413 | UNSHIFT(self, ...) |
414 | SV* self |
415 | CODE: |
170958c3 |
416 | shared_sv* shared = INT2PTR(shared_sv*, SvIV(SvRV(self))); |
aaf3876d |
417 | int i; |
418 | SHAREDSvLOCK(shared); |
419 | SHAREDSvEDIT(shared); |
420 | av_unshift((AV*)SHAREDSvGET(shared), items - 1); |
421 | SHAREDSvRELEASE(shared); |
422 | for(i = 1; i < items; i++) { |
423 | shared_sv* slot = Perl_sharedsv_new(aTHX); |
424 | SV* tmp = ST(i); |
79a24c1c |
425 | if(SvROK(tmp)) { |
426 | shared_sv* target = Perl_sharedsv_find(aTHX_ SvRV(tmp)); |
427 | if(!target) { |
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 |
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 |
438 | } |
439 | SHAREDSvUNLOCK(shared); |
440 | |
441 | SV* |
442 | POP(self) |
443 | SV* self |
444 | CODE: |
170958c3 |
445 | shared_sv* shared = INT2PTR(shared_sv*, SvIV(SvRV(self))); |
aaf3876d |
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 |
456 | retval = shared_sv_attach_sv(NULL,target); |
457 | } else { |
458 | retval = newSVsv(SHAREDSvGET(slot)); |
459 | } |
aaf3876d |
460 | Perl_sharedsv_thrcnt_dec(aTHX_ slot); |
461 | } else { |
462 | retval = &PL_sv_undef; |
463 | } |
464 | SHAREDSvUNLOCK(shared); |
465 | RETVAL = retval; |
466 | OUTPUT: |
467 | RETVAL |
468 | |
469 | |
470 | SV* |
471 | SHIFT(self) |
472 | SV* self |
473 | CODE: |
170958c3 |
474 | shared_sv* shared = INT2PTR(shared_sv*, SvIV(SvRV(self))); |
aaf3876d |
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 |
485 | retval = shared_sv_attach_sv(NULL,target); |
486 | } else { |
487 | retval = newSVsv(SHAREDSvGET(slot)); |
488 | } |
aaf3876d |
489 | Perl_sharedsv_thrcnt_dec(aTHX_ slot); |
490 | } else { |
491 | retval = &PL_sv_undef; |
492 | } |
493 | SHAREDSvUNLOCK(shared); |
494 | RETVAL = retval; |
495 | OUTPUT: |
496 | RETVAL |
497 | |
498 | void |
499 | CLEAR(self) |
500 | SV* self |
501 | CODE: |
170958c3 |
502 | shared_sv* shared = INT2PTR(shared_sv*, SvIV(SvRV(self))); |
aaf3876d |
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 |
512 | } |
513 | i--; |
514 | } |
515 | SHAREDSvEDIT(shared); |
516 | av_clear((AV*)SHAREDSvGET(shared)); |
517 | SHAREDSvRELEASE(shared); |
518 | SHAREDSvUNLOCK(shared); |
519 | |
520 | void |
521 | EXTEND(self, count) |
522 | SV* self |
523 | SV* count |
524 | CODE: |
170958c3 |
525 | shared_sv* shared = INT2PTR(shared_sv*, SvIV(SvRV(self))); |
aaf3876d |
526 | SHAREDSvEDIT(shared); |
527 | av_extend((AV*)SHAREDSvGET(shared), (I32) SvIV(count)); |
528 | SHAREDSvRELEASE(shared); |
529 | |
530 | |
531 | |
532 | |
533 | SV* |
534 | EXISTS(self, index) |
535 | SV* self |
536 | SV* index |
537 | CODE: |
170958c3 |
538 | shared_sv* shared = INT2PTR(shared_sv*, SvIV(SvRV(self))); |
aaf3876d |
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 | |
549 | void |
550 | STORESIZE(self,count) |
551 | SV* self |
552 | SV* count |
553 | CODE: |
170958c3 |
554 | shared_sv* shared = INT2PTR(shared_sv*, SvIV(SvRV(self))); |
aaf3876d |
555 | SHAREDSvEDIT(shared); |
556 | av_fill((AV*) SHAREDSvGET(shared), (I32) SvIV(count)); |
557 | SHAREDSvRELEASE(shared); |
558 | |
559 | SV* |
560 | FETCHSIZE(self) |
561 | SV* self |
562 | CODE: |
170958c3 |
563 | shared_sv* shared = INT2PTR(shared_sv*, SvIV(SvRV(self))); |
aaf3876d |
564 | SHAREDSvLOCK(shared); |
565 | RETVAL = newSViv(av_len((AV*) SHAREDSvGET(shared)) + 1); |
566 | SHAREDSvUNLOCK(shared); |
567 | OUTPUT: |
568 | RETVAL |
569 | |
570 | SV* |
571 | DELETE(self,index) |
572 | SV* self |
573 | SV* index |
574 | CODE: |
170958c3 |
575 | shared_sv* shared = INT2PTR(shared_sv*, SvIV(SvRV(self))); |
aaf3876d |
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 |
587 | RETVAL = shared_sv_attach_sv(NULL,target); |
588 | } else { |
589 | RETVAL = newSVsv(SHAREDSvGET(slot)); |
590 | } |
aaf3876d |
591 | Perl_sharedsv_thrcnt_dec(aTHX_ slot); |
592 | } else { |
593 | RETVAL = &PL_sv_undef; |
594 | } |
595 | } else { |
596 | RETVAL = &PL_sv_undef; |
597 | } |
598 | SHAREDSvUNLOCK(shared); |
599 | OUTPUT: |
600 | RETVAL |
601 | |
602 | AV* |
603 | SPLICE(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 |
610 | MODULE = threads::shared PACKAGE = threads::shared::hv |
aaf3876d |
611 | |
8669ce85 |
612 | SV* |
613 | new(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 |
619 | SHAREDSvEDIT(shared); |
620 | SHAREDSvGET(shared) = (SV*) newHV(); |
621 | SHAREDSvRELEASE(shared); |
622 | RETVAL = obj; |
623 | OUTPUT: |
624 | RETVAL |
625 | |
626 | void |
627 | STORE(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 |
633 | shared_sv* slot; |
634 | SV* hentry; |
635 | SV** hentry_; |
636 | STRLEN len; |
637 | char* ckey = SvPV(key, len); |
409b1fd3 |
638 | SHAREDSvLOCK(shared); |
0d76d117 |
639 | if(SvROK(value)) { |
640 | shared_sv* target = Perl_sharedsv_find(aTHX_ SvRV(value)); |
641 | if(!target) { |
642 | Perl_croak(aTHX_ "You cannot assign a non shared reference to a shared hash"); |
643 | } |
409b1fd3 |
644 | SHAREDSvEDIT(shared); |
170958c3 |
645 | value = newRV_noinc(newSViv(PTR2IV(target))); |
409b1fd3 |
646 | SHAREDSvRELEASE(shared); |
0d76d117 |
647 | } |
8669ce85 |
648 | hentry_ = hv_fetch((HV*) SHAREDSvGET(shared), ckey, len, 0); |
649 | if(hentry_ && SvIV((*hentry_))) { |
650 | hentry = (*hentry_); |
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 |
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 |
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 |
667 | SHAREDSvUNLOCK(shared); |
668 | |
669 | |
670 | SV* |
671 | FETCH(self, key) |
672 | SV* self |
673 | SV* key |
674 | CODE: |
170958c3 |
675 | shared_sv* shared = INT2PTR(shared_sv*, SvIV(SvRV(self))); |
8669ce85 |
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 |
692 | retval = shared_sv_attach_sv(NULL, target); |
693 | } else { |
694 | retval = newSVsv(SHAREDSvGET(slot)); |
695 | } |
8669ce85 |
696 | } |
697 | } else { |
698 | retval = &PL_sv_undef; |
699 | } |
700 | SHAREDSvUNLOCK(shared); |
701 | RETVAL = retval; |
702 | OUTPUT: |
703 | RETVAL |
704 | |
705 | void |
706 | CLEAR(self) |
707 | SV* self |
708 | CODE: |
170958c3 |
709 | shared_sv* shared = INT2PTR(shared_sv*, SvIV(SvRV(self))); |
8669ce85 |
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 |
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 | |
725 | SV* |
726 | FIRSTKEY(self) |
727 | SV* self |
728 | CODE: |
170958c3 |
729 | shared_sv* shared = INT2PTR(shared_sv*, SvIV(SvRV(self))); |
8669ce85 |
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 | |
747 | SV* |
748 | NEXTKEY(self, oldkey) |
749 | SV* self |
750 | SV* oldkey |
751 | CODE: |
170958c3 |
752 | shared_sv* shared = INT2PTR(shared_sv*, SvIV(SvRV(self))); |
8669ce85 |
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 | |
769 | SV* |
770 | EXISTS(self, key) |
771 | SV* self |
772 | SV* key |
773 | CODE: |
170958c3 |
774 | shared_sv* shared = INT2PTR(shared_sv*, SvIV(SvRV(self))); |
8669ce85 |
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 | |
787 | SV* |
788 | DELETE(self, key) |
789 | SV* self |
790 | SV* key |
791 | CODE: |
170958c3 |
792 | shared_sv* shared = INT2PTR(shared_sv*, SvIV(SvRV(self))); |
8669ce85 |
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 |
805 | RETVAL = shared_sv_attach_sv(NULL, target); |
806 | } else { |
807 | RETVAL = newSVsv(SHAREDSvGET(slot)); |
808 | } |
8669ce85 |
809 | Perl_sharedsv_thrcnt_dec(aTHX_ slot); |
810 | } else { |
811 | RETVAL = &PL_sv_undef; |
812 | } |
813 | SHAREDSvUNLOCK(shared); |
814 | OUTPUT: |
815 | RETVAL |