Commit | Line | Data |
b050c948 |
1 | |
2 | #include "EXTERN.h" |
3 | #include "perl.h" |
4 | #include "XSUB.h" |
5 | |
6 | |
7 | void shared_sv_attach_sv (SV* sv, shared_sv* shared) { |
8 | HV* shared_hv = get_hv("threads::shared::shared", FALSE); |
9 | SV* id = newSViv((IV)shared); |
10 | STRLEN length = sv_len(id); |
11 | SV* tiedobject; |
12 | SV** tiedobject_ = hv_fetch(shared_hv, SvPV(id,length), length, 0); |
13 | if(tiedobject_) { |
14 | tiedobject = (*tiedobject_); |
15 | SvROK_on(sv); |
16 | SvRV(sv) = SvRV(tiedobject); |
17 | |
18 | } else { |
19 | croak("die\n"); |
20 | } |
21 | } |
22 | |
23 | |
24 | int shared_sv_fetch_mg (pTHX_ SV* sv, MAGIC *mg) { |
25 | shared_sv* shared = (shared_sv*) SvIV(mg->mg_obj); |
26 | SHAREDSvLOCK(shared); |
55fc11ad |
27 | if(mg->mg_private != shared->index) { |
28 | if(SvROK(SHAREDSvGET(shared))) { |
29 | shared_sv* target = (shared_sv*) SvIV(SvRV(SHAREDSvGET(shared))); |
30 | shared_sv_attach_sv(sv, target); |
31 | } else { |
32 | sv_setsv(sv, SHAREDSvGET(shared)); |
33 | } |
34 | mg->mg_private = shared->index; |
b050c948 |
35 | } |
36 | SHAREDSvUNLOCK(shared); |
37 | |
38 | return 0; |
39 | } |
40 | |
41 | int shared_sv_store_mg (pTHX_ SV* sv, MAGIC *mg) { |
42 | shared_sv* shared = (shared_sv*) SvIV(mg->mg_obj); |
43 | SHAREDSvLOCK(shared); |
44 | if(SvROK(SHAREDSvGET(shared))) |
45 | Perl_sharedsv_thrcnt_dec(aTHX_ (shared_sv*) SvIV(SvRV(SHAREDSvGET(shared)))); |
b050c948 |
46 | if(SvROK(sv)) { |
47 | shared_sv* target = Perl_sharedsv_find(aTHX_ SvRV(sv)); |
48 | if(!target) { |
49 | SHAREDSvRELEASE(shared); |
50 | sv_setsv(sv,SHAREDSvGET(shared)); |
51 | SHAREDSvUNLOCK(shared); |
52 | Perl_croak(aTHX_ "You cannot assign a non shared reference to a shared scalar"); |
53 | } |
f70d29d4 |
54 | SHAREDSvEDIT(shared); |
b050c948 |
55 | Perl_sv_free(PL_sharedsv_space,SHAREDSvGET(shared)); |
56 | SHAREDSvGET(shared) = newRV_noinc(newSViv((IV)target)); |
b050c948 |
57 | } else { |
f70d29d4 |
58 | SHAREDSvEDIT(shared); |
59 | sv_setsv(SHAREDSvGET(shared), sv); |
b050c948 |
60 | } |
55fc11ad |
61 | shared->index++; |
62 | mg->mg_private = shared->index; |
b050c948 |
63 | SHAREDSvRELEASE(shared); |
64 | if(SvROK(SHAREDSvGET(shared))) |
65 | Perl_sharedsv_thrcnt_inc(aTHX_ (shared_sv*) SvIV(SvRV(SHAREDSvGET(shared)))); |
66 | SHAREDSvUNLOCK(shared); |
67 | return 0; |
68 | } |
69 | |
70 | int shared_sv_destroy_mg (pTHX_ SV* sv, MAGIC *mg) { |
71 | shared_sv* shared = (shared_sv*) SvIV(mg->mg_obj); |
72 | if(!shared) |
73 | return 0; |
74 | Perl_sharedsv_thrcnt_dec(aTHX_ shared); |
75 | } |
76 | |
77 | MGVTBL svtable = {MEMBER_TO_FPTR(shared_sv_fetch_mg), |
78 | MEMBER_TO_FPTR(shared_sv_store_mg), |
79 | 0, |
80 | 0, |
81 | MEMBER_TO_FPTR(shared_sv_destroy_mg) |
82 | }; |
83 | |
84 | MODULE = threads::shared PACKAGE = threads::shared |
85 | |
86 | |
87 | PROTOTYPES: DISABLE |
88 | |
89 | |
90 | SV* |
91 | ptr(ref) |
92 | SV* ref |
93 | CODE: |
94 | RETVAL = newSViv(SvIV(SvRV(ref))); |
95 | OUTPUT: |
96 | RETVAL |
97 | |
98 | |
99 | SV* |
100 | _thrcnt(ref) |
101 | SV* ref |
102 | CODE: |
103 | shared_sv* shared = Perl_sharedsv_find(aTHX, ref); |
104 | if(!shared) |
105 | croak("thrcnt can only be used on shared values"); |
106 | SHAREDSvLOCK(shared); |
107 | RETVAL = newSViv(SvREFCNT(SHAREDSvGET(shared))); |
108 | SHAREDSvUNLOCK(shared); |
109 | OUTPUT: |
110 | RETVAL |
111 | |
112 | |
113 | void |
114 | thrcnt_inc(ref) |
115 | SV* ref |
116 | CODE: |
117 | shared_sv* shared; |
118 | if(SvROK(ref)) |
119 | ref = SvRV(ref); |
120 | shared = Perl_sharedsv_find(aTHX, ref); |
121 | if(!shared) |
122 | croak("thrcnt can only be used on shared values"); |
123 | Perl_sharedsv_thrcnt_inc(aTHX_ shared); |
124 | |
125 | |
126 | MODULE = threads::shared PACKAGE = threads::shared::sv |
127 | |
128 | SV* |
129 | new(class, value) |
130 | SV* class |
131 | SV* value |
132 | CODE: |
133 | shared_sv* shared = Perl_sharedsv_new(aTHX); |
134 | MAGIC* shared_magic; |
135 | SV* obj = newSViv((IV)shared); |
136 | SHAREDSvEDIT(shared); |
137 | SHAREDSvGET(shared) = newSVsv(value); |
138 | SHAREDSvRELEASE(shared); |
139 | sv_magic(value, 0, PERL_MAGIC_ext, "threads::shared", 16); |
140 | shared_magic = mg_find(value, PERL_MAGIC_ext); |
141 | shared_magic->mg_virtual = &svtable; |
142 | shared_magic->mg_obj = newSViv((IV)shared); |
143 | shared_magic->mg_flags |= MGf_REFCOUNTED; |
55fc11ad |
144 | shared_magic->mg_private = 0; |
b050c948 |
145 | SvMAGICAL_on(value); |
146 | RETVAL = obj; |
147 | OUTPUT: |
148 | RETVAL |
149 | |
150 | |
aaf3876d |
151 | MODULE = threads::shared PACKAGE = threads::shared::av |
152 | |
153 | SV* |
154 | new(class, value) |
155 | SV* class |
156 | SV* value |
157 | CODE: |
158 | shared_sv* shared = Perl_sharedsv_new(aTHX); |
159 | SV* obj = newSViv((IV)shared); |
160 | SHAREDSvEDIT(shared); |
161 | SHAREDSvGET(shared) = (SV*) newAV(); |
162 | SHAREDSvRELEASE(shared); |
163 | RETVAL = obj; |
164 | OUTPUT: |
165 | RETVAL |
166 | |
167 | void |
168 | STORE(self, index, value) |
169 | SV* self |
170 | SV* index |
171 | SV* value |
172 | CODE: |
173 | shared_sv* shared = (shared_sv*) SvIV(SvRV(self)); |
174 | shared_sv* slot; |
175 | SV* aentry; |
176 | SV** aentry_; |
177 | SHAREDSvLOCK(shared); |
178 | aentry_ = av_fetch((AV*) SHAREDSvGET(shared), SvIV(index), 0); |
179 | if(aentry_ && SvIV((*aentry_))) { |
180 | aentry = (*aentry_); |
181 | slot = (shared_sv*) SvIV(aentry); |
182 | if(SvROK(SHAREDSvGET(slot))) |
183 | Perl_sharedsv_thrcnt_dec(aTHX_ (shared_sv*) SvIV(SvRV(SHAREDSvGET(slot)))); |
184 | SHAREDSvEDIT(slot); |
185 | sv_setsv(SHAREDSvGET(slot), value); |
186 | SHAREDSvRELEASE(slot); |
187 | } else { |
188 | slot = Perl_sharedsv_new(aTHX); |
189 | SHAREDSvEDIT(shared); |
190 | SHAREDSvGET(slot) = newSVsv(value); |
191 | aentry = newSViv((IV)slot); |
192 | av_store((AV*) SHAREDSvGET(shared), SvIV(index), aentry); |
193 | SHAREDSvRELEASE(shared); |
194 | } |
195 | SHAREDSvUNLOCK(shared); |
196 | |
197 | SV* |
198 | FETCH(self, index) |
199 | SV* self |
200 | SV* index |
201 | CODE: |
202 | shared_sv* shared = (shared_sv*) SvIV(SvRV(self)); |
203 | shared_sv* slot; |
204 | SV* aentry; |
205 | SV** aentry_; |
206 | SV* retval; |
207 | SHAREDSvLOCK(shared); |
208 | aentry_ = av_fetch((AV*) SHAREDSvGET(shared), SvIV(index),0); |
209 | if(aentry_) { |
210 | aentry = (*aentry_); |
211 | if(SvTYPE(aentry) == SVt_NULL) { |
212 | retval = &PL_sv_undef; |
213 | } else { |
214 | slot = (shared_sv*) SvIV(aentry); |
215 | retval = newSVsv(SHAREDSvGET(slot)); |
216 | } |
217 | } else { |
218 | retval = &PL_sv_undef; |
219 | } |
220 | SHAREDSvUNLOCK(shared); |
221 | RETVAL = retval; |
222 | OUTPUT: |
223 | RETVAL |
224 | |
225 | void |
226 | PUSH(self, ...) |
227 | SV* self |
228 | CODE: |
229 | shared_sv* shared = (shared_sv*) SvIV(SvRV(self)); |
230 | int i; |
231 | SHAREDSvLOCK(shared); |
232 | for(i = 1; i < items; i++) { |
233 | shared_sv* slot = Perl_sharedsv_new(aTHX); |
234 | SV* tmp = ST(i); |
235 | SHAREDSvEDIT(slot); |
236 | SHAREDSvGET(slot) = newSVsv(tmp); |
237 | av_push((AV*) SHAREDSvGET(shared), newSViv((IV)slot)); |
238 | SHAREDSvRELEASE(slot); |
239 | } |
240 | SHAREDSvUNLOCK(shared); |
241 | |
242 | void |
243 | UNSHIFT(self, ...) |
244 | SV* self |
245 | CODE: |
246 | shared_sv* shared = (shared_sv*) SvIV(SvRV(self)); |
247 | int i; |
248 | SHAREDSvLOCK(shared); |
249 | SHAREDSvEDIT(shared); |
250 | av_unshift((AV*)SHAREDSvGET(shared), items - 1); |
251 | SHAREDSvRELEASE(shared); |
252 | for(i = 1; i < items; i++) { |
253 | shared_sv* slot = Perl_sharedsv_new(aTHX); |
254 | SV* tmp = ST(i); |
255 | SHAREDSvEDIT(slot); |
256 | SHAREDSvGET(slot) = newSVsv(tmp); |
257 | av_store((AV*) SHAREDSvGET(shared), i - 1, newSViv((IV)slot)); |
258 | SHAREDSvRELEASE(slot); |
259 | } |
260 | SHAREDSvUNLOCK(shared); |
261 | |
262 | SV* |
263 | POP(self) |
264 | SV* self |
265 | CODE: |
266 | shared_sv* shared = (shared_sv*) SvIV(SvRV(self)); |
267 | shared_sv* slot; |
268 | SV* retval; |
269 | SHAREDSvLOCK(shared); |
270 | SHAREDSvEDIT(shared); |
271 | retval = av_pop((AV*)SHAREDSvGET(shared)); |
272 | SHAREDSvRELEASE(shared); |
273 | if(retval && SvIV(retval)) { |
274 | slot = (shared_sv*) SvIV(retval); |
275 | retval = newSVsv(SHAREDSvGET(slot)); |
276 | Perl_sharedsv_thrcnt_dec(aTHX_ slot); |
277 | } else { |
278 | retval = &PL_sv_undef; |
279 | } |
280 | SHAREDSvUNLOCK(shared); |
281 | RETVAL = retval; |
282 | OUTPUT: |
283 | RETVAL |
284 | |
285 | |
286 | SV* |
287 | SHIFT(self) |
288 | SV* self |
289 | CODE: |
290 | shared_sv* shared = (shared_sv*) SvIV(SvRV(self)); |
291 | shared_sv* slot; |
292 | SV* retval; |
293 | SHAREDSvLOCK(shared); |
294 | SHAREDSvEDIT(shared); |
295 | retval = av_shift((AV*)SHAREDSvGET(shared)); |
296 | SHAREDSvRELEASE(shared); |
297 | if(retval && SvIV(retval)) { |
298 | slot = (shared_sv*) SvIV(retval); |
299 | retval = newSVsv(SHAREDSvGET(slot)); |
300 | Perl_sharedsv_thrcnt_dec(aTHX_ slot); |
301 | } else { |
302 | retval = &PL_sv_undef; |
303 | } |
304 | SHAREDSvUNLOCK(shared); |
305 | RETVAL = retval; |
306 | OUTPUT: |
307 | RETVAL |
308 | |
309 | void |
310 | CLEAR(self) |
311 | SV* self |
312 | CODE: |
313 | shared_sv* shared = (shared_sv*) SvIV(SvRV(self)); |
314 | shared_sv* slot; |
315 | SV** svp; |
316 | I32 i; |
317 | SHAREDSvLOCK(shared); |
318 | svp = AvARRAY((AV*)SHAREDSvGET(shared)); |
319 | i = AvFILLp((AV*)SHAREDSvGET(shared)); |
320 | while ( i >= 0) { |
321 | if(SvIV(svp[i])) { |
322 | Perl_sharedsv_thrcnt_dec(aTHX_ (shared_sv*) SvIV(svp[i])); |
323 | } |
324 | i--; |
325 | } |
326 | SHAREDSvEDIT(shared); |
327 | av_clear((AV*)SHAREDSvGET(shared)); |
328 | SHAREDSvRELEASE(shared); |
329 | SHAREDSvUNLOCK(shared); |
330 | |
331 | void |
332 | EXTEND(self, count) |
333 | SV* self |
334 | SV* count |
335 | CODE: |
336 | shared_sv* shared = (shared_sv*) SvIV(SvRV(self)); |
337 | SHAREDSvEDIT(shared); |
338 | av_extend((AV*)SHAREDSvGET(shared), (I32) SvIV(count)); |
339 | SHAREDSvRELEASE(shared); |
340 | |
341 | |
342 | |
343 | |
344 | SV* |
345 | EXISTS(self, index) |
346 | SV* self |
347 | SV* index |
348 | CODE: |
349 | shared_sv* shared = (shared_sv*) SvIV(SvRV(self)); |
350 | I32 exists; |
351 | SHAREDSvLOCK(shared); |
352 | exists = av_exists((AV*) SHAREDSvGET(shared), (I32) SvIV(index)); |
353 | if(exists) { |
354 | RETVAL = &PL_sv_yes; |
355 | } else { |
356 | RETVAL = &PL_sv_no; |
357 | } |
358 | SHAREDSvUNLOCK(shared); |
359 | |
360 | void |
361 | STORESIZE(self,count) |
362 | SV* self |
363 | SV* count |
364 | CODE: |
365 | shared_sv* shared = (shared_sv*) SvIV(SvRV(self)); |
366 | SHAREDSvEDIT(shared); |
367 | av_fill((AV*) SHAREDSvGET(shared), (I32) SvIV(count)); |
368 | SHAREDSvRELEASE(shared); |
369 | |
370 | SV* |
371 | FETCHSIZE(self) |
372 | SV* self |
373 | CODE: |
374 | shared_sv* shared = (shared_sv*) SvIV(SvRV(self)); |
375 | SHAREDSvLOCK(shared); |
376 | RETVAL = newSViv(av_len((AV*) SHAREDSvGET(shared)) + 1); |
377 | SHAREDSvUNLOCK(shared); |
378 | OUTPUT: |
379 | RETVAL |
380 | |
381 | SV* |
382 | DELETE(self,index) |
383 | SV* self |
384 | SV* index |
385 | CODE: |
386 | shared_sv* shared = (shared_sv*) SvIV(SvRV(self)); |
387 | shared_sv* slot; |
388 | SHAREDSvLOCK(shared); |
389 | if(av_exists((AV*) SHAREDSvGET(shared), (I32) SvIV(index))) { |
390 | SV* tmp; |
391 | SHAREDSvEDIT(shared); |
392 | tmp = av_delete((AV*)SHAREDSvGET(shared), (I32) SvIV(index),0); |
393 | SHAREDSvRELEASE(shared); |
394 | if(SvIV(tmp)) { |
395 | slot = (shared_sv*) SvIV(tmp); |
396 | RETVAL = newSVsv(SHAREDSvGET(slot)); |
397 | Perl_sharedsv_thrcnt_dec(aTHX_ slot); |
398 | } else { |
399 | RETVAL = &PL_sv_undef; |
400 | } |
401 | } else { |
402 | RETVAL = &PL_sv_undef; |
403 | } |
404 | SHAREDSvUNLOCK(shared); |
405 | OUTPUT: |
406 | RETVAL |
407 | |
408 | AV* |
409 | SPLICE(self, offset, length, ...) |
410 | SV* self |
411 | SV* offset |
412 | SV* length |
413 | CODE: |
414 | croak("Splice is not implmented for shared arrays"); |
415 | |
416 | |