This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
We need to do sharedsv_find in the original perl context.
[perl5.git] / ext / threads / shared / shared.xs
CommitLineData
b050c948
AB
1
2#include "EXTERN.h"
3#include "perl.h"
4#include "XSUB.h"
5
6
7void 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
24int shared_sv_fetch_mg (pTHX_ SV* sv, MAGIC *mg) {
25 shared_sv* shared = (shared_sv*) SvIV(mg->mg_obj);
26 SHAREDSvLOCK(shared);
55fc11ad
AB
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
AB
35 }
36 SHAREDSvUNLOCK(shared);
37
38 return 0;
39}
40
41int 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
AB
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
AB
55 Perl_sv_free(PL_sharedsv_space,SHAREDSvGET(shared));
56 SHAREDSvGET(shared) = newRV_noinc(newSViv((IV)target));
b050c948 57 } else {
f70d29d4
AB
58 SHAREDSvEDIT(shared);
59 sv_setsv(SHAREDSvGET(shared), sv);
b050c948 60 }
55fc11ad
AB
61 shared->index++;
62 mg->mg_private = shared->index;
b050c948
AB
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
70int 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
77MGVTBL 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
84MODULE = threads::shared PACKAGE = threads::shared
85
86
87PROTOTYPES: DISABLE
88
89
90SV*
91ptr(ref)
92 SV* ref
93 CODE:
94 RETVAL = newSViv(SvIV(SvRV(ref)));
95 OUTPUT:
96 RETVAL
97
98
99SV*
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
113void
114thrcnt_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
126MODULE = threads::shared PACKAGE = threads::shared::sv
127
128SV*
129new(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
AB
145 SvMAGICAL_on(value);
146 RETVAL = obj;
147 OUTPUT:
148 RETVAL
149
150
aaf3876d
AB
151MODULE = threads::shared PACKAGE = threads::shared::av
152
153SV*
154new(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
167void
168STORE(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
197SV*
198FETCH(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
225void
226PUSH(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
242void
243UNSHIFT(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
262SV*
263POP(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
286SV*
287SHIFT(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
309void
310CLEAR(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
331void
332EXTEND(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
344SV*
345EXISTS(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
360void
361STORESIZE(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
370SV*
371FETCHSIZE(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
381SV*
382DELETE(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
408AV*
409SPLICE(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