This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Support for references in shared arrays.
[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
0d76d117 7SV* shared_sv_attach_sv (SV* sv, shared_sv* shared) {
b050c948
AB
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_);
0d76d117
AB
15 if(sv) {
16 SvROK_on(sv);
17 SvRV(sv) = SvRV(tiedobject);
18 } else {
19 sv = newRV(SvRV(tiedobject));
20 }
b050c948
AB
21 } else {
22 croak("die\n");
23 }
0d76d117 24 return sv;
b050c948
AB
25}
26
27
28int shared_sv_fetch_mg (pTHX_ SV* sv, MAGIC *mg) {
29 shared_sv* shared = (shared_sv*) SvIV(mg->mg_obj);
30 SHAREDSvLOCK(shared);
55fc11ad
AB
31 if(mg->mg_private != shared->index) {
32 if(SvROK(SHAREDSvGET(shared))) {
33 shared_sv* target = (shared_sv*) SvIV(SvRV(SHAREDSvGET(shared)));
34 shared_sv_attach_sv(sv, target);
35 } else {
36 sv_setsv(sv, SHAREDSvGET(shared));
37 }
38 mg->mg_private = shared->index;
b050c948
AB
39 }
40 SHAREDSvUNLOCK(shared);
41
42 return 0;
43}
44
45int shared_sv_store_mg (pTHX_ SV* sv, MAGIC *mg) {
46 shared_sv* shared = (shared_sv*) SvIV(mg->mg_obj);
47 SHAREDSvLOCK(shared);
48 if(SvROK(SHAREDSvGET(shared)))
49 Perl_sharedsv_thrcnt_dec(aTHX_ (shared_sv*) SvIV(SvRV(SHAREDSvGET(shared))));
b050c948
AB
50 if(SvROK(sv)) {
51 shared_sv* target = Perl_sharedsv_find(aTHX_ SvRV(sv));
52 if(!target) {
b050c948
AB
53 sv_setsv(sv,SHAREDSvGET(shared));
54 SHAREDSvUNLOCK(shared);
55 Perl_croak(aTHX_ "You cannot assign a non shared reference to a shared scalar");
56 }
f70d29d4 57 SHAREDSvEDIT(shared);
b050c948
AB
58 Perl_sv_free(PL_sharedsv_space,SHAREDSvGET(shared));
59 SHAREDSvGET(shared) = newRV_noinc(newSViv((IV)target));
b050c948 60 } else {
f70d29d4
AB
61 SHAREDSvEDIT(shared);
62 sv_setsv(SHAREDSvGET(shared), sv);
b050c948 63 }
55fc11ad
AB
64 shared->index++;
65 mg->mg_private = shared->index;
b050c948
AB
66 SHAREDSvRELEASE(shared);
67 if(SvROK(SHAREDSvGET(shared)))
68 Perl_sharedsv_thrcnt_inc(aTHX_ (shared_sv*) SvIV(SvRV(SHAREDSvGET(shared))));
69 SHAREDSvUNLOCK(shared);
70 return 0;
71}
72
73int shared_sv_destroy_mg (pTHX_ SV* sv, MAGIC *mg) {
74 shared_sv* shared = (shared_sv*) SvIV(mg->mg_obj);
75 if(!shared)
76 return 0;
77 Perl_sharedsv_thrcnt_dec(aTHX_ shared);
78}
79
80MGVTBL svtable = {MEMBER_TO_FPTR(shared_sv_fetch_mg),
81 MEMBER_TO_FPTR(shared_sv_store_mg),
82 0,
83 0,
84 MEMBER_TO_FPTR(shared_sv_destroy_mg)
85};
86
87MODULE = threads::shared PACKAGE = threads::shared
88
89
90PROTOTYPES: DISABLE
91
92
93SV*
94ptr(ref)
95 SV* ref
96 CODE:
97 RETVAL = newSViv(SvIV(SvRV(ref)));
98 OUTPUT:
99 RETVAL
100
101
102SV*
103_thrcnt(ref)
104 SV* ref
105 CODE:
866fba46
AB
106 shared_sv* shared;
107 if(SvROK(ref))
108 ref = SvRV(ref);
109 shared = Perl_sharedsv_find(aTHX, ref);
b050c948
AB
110 if(!shared)
111 croak("thrcnt can only be used on shared values");
112 SHAREDSvLOCK(shared);
113 RETVAL = newSViv(SvREFCNT(SHAREDSvGET(shared)));
114 SHAREDSvUNLOCK(shared);
115 OUTPUT:
116 RETVAL
117
118
119void
120thrcnt_inc(ref)
121 SV* ref
122 CODE:
123 shared_sv* shared;
124 if(SvROK(ref))
125 ref = SvRV(ref);
126 shared = Perl_sharedsv_find(aTHX, ref);
127 if(!shared)
128 croak("thrcnt can only be used on shared values");
129 Perl_sharedsv_thrcnt_inc(aTHX_ shared);
130
866fba46
AB
131void
132_thrcnt_dec(ref)
133 SV* ref
134 CODE:
135 shared_sv* shared = (shared_sv*) SvIV(ref);
136 if(!shared)
137 croak("thrcnt can only be used on shared values");
138 Perl_sharedsv_thrcnt_dec(aTHX_ shared);
139
b050c948
AB
140
141MODULE = threads::shared PACKAGE = threads::shared::sv
142
143SV*
144new(class, value)
145 SV* class
146 SV* value
147 CODE:
148 shared_sv* shared = Perl_sharedsv_new(aTHX);
149 MAGIC* shared_magic;
150 SV* obj = newSViv((IV)shared);
151 SHAREDSvEDIT(shared);
152 SHAREDSvGET(shared) = newSVsv(value);
153 SHAREDSvRELEASE(shared);
154 sv_magic(value, 0, PERL_MAGIC_ext, "threads::shared", 16);
155 shared_magic = mg_find(value, PERL_MAGIC_ext);
156 shared_magic->mg_virtual = &svtable;
157 shared_magic->mg_obj = newSViv((IV)shared);
158 shared_magic->mg_flags |= MGf_REFCOUNTED;
55fc11ad 159 shared_magic->mg_private = 0;
b050c948
AB
160 SvMAGICAL_on(value);
161 RETVAL = obj;
162 OUTPUT:
163 RETVAL
164
165
aaf3876d
AB
166MODULE = threads::shared PACKAGE = threads::shared::av
167
168SV*
169new(class, value)
170 SV* class
171 SV* value
172 CODE:
173 shared_sv* shared = Perl_sharedsv_new(aTHX);
174 SV* obj = newSViv((IV)shared);
175 SHAREDSvEDIT(shared);
176 SHAREDSvGET(shared) = (SV*) newAV();
177 SHAREDSvRELEASE(shared);
178 RETVAL = obj;
179 OUTPUT:
180 RETVAL
181
182void
183STORE(self, index, value)
184 SV* self
185 SV* index
186 SV* value
187 CODE:
188 shared_sv* shared = (shared_sv*) SvIV(SvRV(self));
189 shared_sv* slot;
190 SV* aentry;
191 SV** aentry_;
79a24c1c
AB
192 if(SvROK(value)) {
193 shared_sv* target = Perl_sharedsv_find(aTHX_ SvRV(value));
194 if(!target) {
195 Perl_croak(aTHX_ "You cannot assign a non shared reference to an shared array");
196 }
197 value = newRV_noinc(newSViv((IV)target));
198 }
aaf3876d
AB
199 SHAREDSvLOCK(shared);
200 aentry_ = av_fetch((AV*) SHAREDSvGET(shared), SvIV(index), 0);
201 if(aentry_ && SvIV((*aentry_))) {
202 aentry = (*aentry_);
203 slot = (shared_sv*) SvIV(aentry);
204 if(SvROK(SHAREDSvGET(slot)))
205 Perl_sharedsv_thrcnt_dec(aTHX_ (shared_sv*) SvIV(SvRV(SHAREDSvGET(slot))));
206 SHAREDSvEDIT(slot);
207 sv_setsv(SHAREDSvGET(slot), value);
208 SHAREDSvRELEASE(slot);
209 } else {
210 slot = Perl_sharedsv_new(aTHX);
211 SHAREDSvEDIT(shared);
212 SHAREDSvGET(slot) = newSVsv(value);
213 aentry = newSViv((IV)slot);
214 av_store((AV*) SHAREDSvGET(shared), SvIV(index), aentry);
215 SHAREDSvRELEASE(shared);
216 }
79a24c1c
AB
217 if(SvROK(SHAREDSvGET(slot)))
218 Perl_sharedsv_thrcnt_inc(aTHX_ (shared_sv*) SvIV(SvRV(SHAREDSvGET(slot))));
219
aaf3876d
AB
220 SHAREDSvUNLOCK(shared);
221
222SV*
223FETCH(self, index)
224 SV* self
225 SV* index
226 CODE:
227 shared_sv* shared = (shared_sv*) SvIV(SvRV(self));
228 shared_sv* slot;
229 SV* aentry;
230 SV** aentry_;
231 SV* retval;
232 SHAREDSvLOCK(shared);
233 aentry_ = av_fetch((AV*) SHAREDSvGET(shared), SvIV(index),0);
234 if(aentry_) {
235 aentry = (*aentry_);
236 if(SvTYPE(aentry) == SVt_NULL) {
237 retval = &PL_sv_undef;
238 } else {
239 slot = (shared_sv*) SvIV(aentry);
79a24c1c
AB
240 if(SvROK(SHAREDSvGET(slot))) {
241 shared_sv* target = (shared_sv*) SvIV(SvRV(SHAREDSvGET(slot)));
242 retval = shared_sv_attach_sv(NULL,target);
243 } else {
244 retval = newSVsv(SHAREDSvGET(slot));
245 }
aaf3876d
AB
246 }
247 } else {
248 retval = &PL_sv_undef;
249 }
250 SHAREDSvUNLOCK(shared);
251 RETVAL = retval;
252 OUTPUT:
253 RETVAL
254
255void
256PUSH(self, ...)
257 SV* self
258 CODE:
259 shared_sv* shared = (shared_sv*) SvIV(SvRV(self));
260 int i;
261 SHAREDSvLOCK(shared);
262 for(i = 1; i < items; i++) {
263 shared_sv* slot = Perl_sharedsv_new(aTHX);
264 SV* tmp = ST(i);
79a24c1c
AB
265 if(SvROK(tmp)) {
266 shared_sv* target = Perl_sharedsv_find(aTHX_ SvRV(tmp));
267 if(!target) {
268 Perl_croak(aTHX_ "You cannot assign a non shared reference to an shared array");
269 }
270 tmp = newRV_noinc(newSViv((IV)target));
271 }
aaf3876d
AB
272 SHAREDSvEDIT(slot);
273 SHAREDSvGET(slot) = newSVsv(tmp);
274 av_push((AV*) SHAREDSvGET(shared), newSViv((IV)slot));
275 SHAREDSvRELEASE(slot);
79a24c1c
AB
276 if(SvROK(SHAREDSvGET(slot)))
277 Perl_sharedsv_thrcnt_inc(aTHX_ (shared_sv*) SvIV(SvRV(SHAREDSvGET(slot))));
aaf3876d
AB
278 }
279 SHAREDSvUNLOCK(shared);
280
281void
282UNSHIFT(self, ...)
283 SV* self
284 CODE:
285 shared_sv* shared = (shared_sv*) SvIV(SvRV(self));
286 int i;
287 SHAREDSvLOCK(shared);
288 SHAREDSvEDIT(shared);
289 av_unshift((AV*)SHAREDSvGET(shared), items - 1);
290 SHAREDSvRELEASE(shared);
291 for(i = 1; i < items; i++) {
292 shared_sv* slot = Perl_sharedsv_new(aTHX);
293 SV* tmp = ST(i);
79a24c1c
AB
294 if(SvROK(tmp)) {
295 shared_sv* target = Perl_sharedsv_find(aTHX_ SvRV(tmp));
296 if(!target) {
297 Perl_croak(aTHX_ "You cannot assign a non shared reference to an shared array");
298 }
299 tmp = newRV_noinc(newSViv((IV)target));
300 }
aaf3876d
AB
301 SHAREDSvEDIT(slot);
302 SHAREDSvGET(slot) = newSVsv(tmp);
303 av_store((AV*) SHAREDSvGET(shared), i - 1, newSViv((IV)slot));
304 SHAREDSvRELEASE(slot);
79a24c1c
AB
305 if(SvROK(SHAREDSvGET(slot)))
306 Perl_sharedsv_thrcnt_inc(aTHX_ (shared_sv*) SvIV(SvRV(SHAREDSvGET(slot))));
aaf3876d
AB
307 }
308 SHAREDSvUNLOCK(shared);
309
310SV*
311POP(self)
312 SV* self
313 CODE:
314 shared_sv* shared = (shared_sv*) SvIV(SvRV(self));
315 shared_sv* slot;
316 SV* retval;
317 SHAREDSvLOCK(shared);
318 SHAREDSvEDIT(shared);
319 retval = av_pop((AV*)SHAREDSvGET(shared));
320 SHAREDSvRELEASE(shared);
321 if(retval && SvIV(retval)) {
322 slot = (shared_sv*) SvIV(retval);
79a24c1c
AB
323 if(SvROK(SHAREDSvGET(slot))) {
324 shared_sv* target = (shared_sv*) SvIV(SvRV(SHAREDSvGET(slot)));
325 retval = shared_sv_attach_sv(NULL,target);
326 } else {
327 retval = newSVsv(SHAREDSvGET(slot));
328 }
aaf3876d
AB
329 Perl_sharedsv_thrcnt_dec(aTHX_ slot);
330 } else {
331 retval = &PL_sv_undef;
332 }
333 SHAREDSvUNLOCK(shared);
334 RETVAL = retval;
335 OUTPUT:
336 RETVAL
337
338
339SV*
340SHIFT(self)
341 SV* self
342 CODE:
343 shared_sv* shared = (shared_sv*) SvIV(SvRV(self));
344 shared_sv* slot;
345 SV* retval;
346 SHAREDSvLOCK(shared);
347 SHAREDSvEDIT(shared);
348 retval = av_shift((AV*)SHAREDSvGET(shared));
349 SHAREDSvRELEASE(shared);
350 if(retval && SvIV(retval)) {
351 slot = (shared_sv*) SvIV(retval);
79a24c1c
AB
352 if(SvROK(SHAREDSvGET(slot))) {
353 shared_sv* target = (shared_sv*) SvIV(SvRV(SHAREDSvGET(slot)));
354 retval = shared_sv_attach_sv(NULL,target);
355 } else {
356 retval = newSVsv(SHAREDSvGET(slot));
357 }
aaf3876d
AB
358 Perl_sharedsv_thrcnt_dec(aTHX_ slot);
359 } else {
360 retval = &PL_sv_undef;
361 }
362 SHAREDSvUNLOCK(shared);
363 RETVAL = retval;
364 OUTPUT:
365 RETVAL
366
367void
368CLEAR(self)
369 SV* self
370 CODE:
371 shared_sv* shared = (shared_sv*) SvIV(SvRV(self));
372 shared_sv* slot;
373 SV** svp;
374 I32 i;
375 SHAREDSvLOCK(shared);
376 svp = AvARRAY((AV*)SHAREDSvGET(shared));
377 i = AvFILLp((AV*)SHAREDSvGET(shared));
378 while ( i >= 0) {
379 if(SvIV(svp[i])) {
380 Perl_sharedsv_thrcnt_dec(aTHX_ (shared_sv*) SvIV(svp[i]));
381 }
382 i--;
383 }
384 SHAREDSvEDIT(shared);
385 av_clear((AV*)SHAREDSvGET(shared));
386 SHAREDSvRELEASE(shared);
387 SHAREDSvUNLOCK(shared);
388
389void
390EXTEND(self, count)
391 SV* self
392 SV* count
393 CODE:
394 shared_sv* shared = (shared_sv*) SvIV(SvRV(self));
395 SHAREDSvEDIT(shared);
396 av_extend((AV*)SHAREDSvGET(shared), (I32) SvIV(count));
397 SHAREDSvRELEASE(shared);
398
399
400
401
402SV*
403EXISTS(self, index)
404 SV* self
405 SV* index
406 CODE:
407 shared_sv* shared = (shared_sv*) SvIV(SvRV(self));
408 I32 exists;
409 SHAREDSvLOCK(shared);
410 exists = av_exists((AV*) SHAREDSvGET(shared), (I32) SvIV(index));
411 if(exists) {
412 RETVAL = &PL_sv_yes;
413 } else {
414 RETVAL = &PL_sv_no;
415 }
416 SHAREDSvUNLOCK(shared);
417
418void
419STORESIZE(self,count)
420 SV* self
421 SV* count
422 CODE:
423 shared_sv* shared = (shared_sv*) SvIV(SvRV(self));
424 SHAREDSvEDIT(shared);
425 av_fill((AV*) SHAREDSvGET(shared), (I32) SvIV(count));
426 SHAREDSvRELEASE(shared);
427
428SV*
429FETCHSIZE(self)
430 SV* self
431 CODE:
432 shared_sv* shared = (shared_sv*) SvIV(SvRV(self));
433 SHAREDSvLOCK(shared);
434 RETVAL = newSViv(av_len((AV*) SHAREDSvGET(shared)) + 1);
435 SHAREDSvUNLOCK(shared);
436 OUTPUT:
437 RETVAL
438
439SV*
440DELETE(self,index)
441 SV* self
442 SV* index
443 CODE:
444 shared_sv* shared = (shared_sv*) SvIV(SvRV(self));
445 shared_sv* slot;
446 SHAREDSvLOCK(shared);
447 if(av_exists((AV*) SHAREDSvGET(shared), (I32) SvIV(index))) {
448 SV* tmp;
449 SHAREDSvEDIT(shared);
450 tmp = av_delete((AV*)SHAREDSvGET(shared), (I32) SvIV(index),0);
451 SHAREDSvRELEASE(shared);
452 if(SvIV(tmp)) {
453 slot = (shared_sv*) SvIV(tmp);
79a24c1c
AB
454 if(SvROK(SHAREDSvGET(slot))) {
455 shared_sv* target = (shared_sv*) SvIV(SvRV(SHAREDSvGET(slot)));
456 RETVAL = shared_sv_attach_sv(NULL,target);
457 } else {
458 RETVAL = newSVsv(SHAREDSvGET(slot));
459 }
aaf3876d
AB
460 Perl_sharedsv_thrcnt_dec(aTHX_ slot);
461 } else {
462 RETVAL = &PL_sv_undef;
463 }
464 } else {
465 RETVAL = &PL_sv_undef;
466 }
467 SHAREDSvUNLOCK(shared);
468 OUTPUT:
469 RETVAL
470
471AV*
472SPLICE(self, offset, length, ...)
473 SV* self
474 SV* offset
475 SV* length
476 CODE:
477 croak("Splice is not implmented for shared arrays");
478
8669ce85 479MODULE = threads::shared PACKAGE = threads::shared::hv
aaf3876d 480
8669ce85
AB
481SV*
482new(class, value)
483 SV* class
484 SV* value
485 CODE:
486 shared_sv* shared = Perl_sharedsv_new(aTHX);
487 SV* obj = newSViv((IV)shared);
488 SHAREDSvEDIT(shared);
489 SHAREDSvGET(shared) = (SV*) newHV();
490 SHAREDSvRELEASE(shared);
491 RETVAL = obj;
492 OUTPUT:
493 RETVAL
494
495void
496STORE(self, key, value)
497 SV* self
498 SV* key
499 SV* value
500 CODE:
501 shared_sv* shared = (shared_sv*) SvIV(SvRV(self));
502 shared_sv* slot;
503 SV* hentry;
504 SV** hentry_;
505 STRLEN len;
506 char* ckey = SvPV(key, len);
0d76d117
AB
507 if(SvROK(value)) {
508 shared_sv* target = Perl_sharedsv_find(aTHX_ SvRV(value));
509 if(!target) {
510 Perl_croak(aTHX_ "You cannot assign a non shared reference to a shared hash");
511 }
512 value = newRV_noinc(newSViv((IV)target));
513 }
8669ce85
AB
514 SHAREDSvLOCK(shared);
515 hentry_ = hv_fetch((HV*) SHAREDSvGET(shared), ckey, len, 0);
516 if(hentry_ && SvIV((*hentry_))) {
517 hentry = (*hentry_);
518 slot = (shared_sv*) SvIV(hentry);
519 if(SvROK(SHAREDSvGET(slot)))
520 Perl_sharedsv_thrcnt_dec(aTHX_ (shared_sv*) SvIV(SvRV(SHAREDSvGET(slot))));
521 SHAREDSvEDIT(slot);
522 sv_setsv(SHAREDSvGET(slot), value);
523 SHAREDSvRELEASE(slot);
524 } else {
525 slot = Perl_sharedsv_new(aTHX);
526 SHAREDSvEDIT(shared);
527 SHAREDSvGET(slot) = newSVsv(value);
528 hentry = newSViv((IV)slot);
529 hv_store((HV*) SHAREDSvGET(shared), ckey,len , hentry, 0);
530 SHAREDSvRELEASE(shared);
531 }
0d76d117
AB
532 if(SvROK(SHAREDSvGET(slot)))
533 Perl_sharedsv_thrcnt_inc(aTHX_ (shared_sv*) SvIV(SvRV(SHAREDSvGET(slot))));
8669ce85
AB
534 SHAREDSvUNLOCK(shared);
535
536
537SV*
538FETCH(self, key)
539 SV* self
540 SV* key
541 CODE:
542 shared_sv* shared = (shared_sv*) SvIV(SvRV(self));
543 shared_sv* slot;
544 SV* hentry;
545 SV** hentry_;
546 SV* retval;
547 STRLEN len;
548 char* ckey = SvPV(key, len);
549 SHAREDSvLOCK(shared);
550 hentry_ = hv_fetch((HV*) SHAREDSvGET(shared), ckey, len,0);
551 if(hentry_) {
552 hentry = (*hentry_);
553 if(SvTYPE(hentry) == SVt_NULL) {
554 retval = &PL_sv_undef;
555 } else {
556 slot = (shared_sv*) SvIV(hentry);
0d76d117
AB
557 if(SvROK(SHAREDSvGET(slot))) {
558 shared_sv* target = (shared_sv*) SvIV(SvRV(SHAREDSvGET(slot)));
559 retval = shared_sv_attach_sv(NULL, target);
560 } else {
561 retval = newSVsv(SHAREDSvGET(slot));
562 }
8669ce85
AB
563 }
564 } else {
565 retval = &PL_sv_undef;
566 }
567 SHAREDSvUNLOCK(shared);
568 RETVAL = retval;
569 OUTPUT:
570 RETVAL
571
572void
573CLEAR(self)
574 SV* self
575 CODE:
576 shared_sv* shared = (shared_sv*) SvIV(SvRV(self));
577 shared_sv* slot;
578 HE* entry;
579 SHAREDSvLOCK(shared);
580 Perl_hv_iterinit(PL_sharedsv_space, (HV*) SHAREDSvGET(shared));
581 entry = Perl_hv_iternext(PL_sharedsv_space, (HV*) SHAREDSvGET(shared));
582 while(entry) {
583 slot = (shared_sv*) SvIV(Perl_hv_iterval(PL_sharedsv_space, (HV*) SHAREDSvGET(shared), entry));
584 Perl_sharedsv_thrcnt_dec(aTHX_ slot);
585 entry = Perl_hv_iternext(PL_sharedsv_space,(HV*) SHAREDSvGET(shared));
586 }
587 SHAREDSvEDIT(shared);
588 hv_clear((HV*) SHAREDSvGET(shared));
589 SHAREDSvRELEASE(shared);
590 SHAREDSvUNLOCK(shared);
591
592SV*
593FIRSTKEY(self)
594 SV* self
595 CODE:
596 shared_sv* shared = (shared_sv*) SvIV(SvRV(self));
597 char* key = NULL;
598 I32 len;
599 HE* entry;
600 SHAREDSvLOCK(shared);
601 Perl_hv_iterinit(PL_sharedsv_space, (HV*) SHAREDSvGET(shared));
602 entry = Perl_hv_iternext(PL_sharedsv_space, (HV*) SHAREDSvGET(shared));
603 if(entry) {
604 key = Perl_hv_iterkey(PL_sharedsv_space, entry,&len);
605 RETVAL = newSVpv(key, len);
606 } else {
607 RETVAL = &PL_sv_undef;
608 }
609 SHAREDSvUNLOCK(shared);
610 OUTPUT:
611 RETVAL
612
613
614SV*
615NEXTKEY(self, oldkey)
616 SV* self
617 SV* oldkey
618 CODE:
619 shared_sv* shared = (shared_sv*) SvIV(SvRV(self));
620 char* key = NULL;
621 I32 len;
622 HE* entry;
623 SHAREDSvLOCK(shared);
624 entry = Perl_hv_iternext(PL_sharedsv_space, (HV*) SHAREDSvGET(shared));
625 if(entry) {
626 key = Perl_hv_iterkey(PL_sharedsv_space, entry,&len);
627 RETVAL = newSVpv(key, len);
628 } else {
629 RETVAL = &PL_sv_undef;
630 }
631 SHAREDSvUNLOCK(shared);
632 OUTPUT:
633 RETVAL
634
635
636SV*
637EXISTS(self, key)
638 SV* self
639 SV* key
640 CODE:
641 shared_sv* shared = (shared_sv*) SvIV(SvRV(self));
642 STRLEN len;
643 char* ckey = SvPV(key, len);
644 SHAREDSvLOCK(shared);
645 if(hv_exists((HV*)SHAREDSvGET(shared), ckey, len)) {
646 RETVAL = &PL_sv_yes;
647 } else {
648 RETVAL = &PL_sv_no;
649 }
650 SHAREDSvUNLOCK(shared);
651 OUTPUT:
652 RETVAL
653
654SV*
655DELETE(self, key)
656 SV* self
657 SV* key
658 CODE:
659 shared_sv* shared = (shared_sv*) SvIV(SvRV(self));
660 shared_sv* slot;
661 STRLEN len;
662 char* ckey = SvPV(key, len);
663 SV* tmp;
664 SHAREDSvLOCK(shared);
665 SHAREDSvEDIT(shared);
666 tmp = hv_delete((HV*) SHAREDSvGET(shared), ckey, len,0);
667 SHAREDSvRELEASE(shared);
668 if(tmp) {
b48e3745 669 slot = (shared_sv*) SvIV(tmp);
0d76d117
AB
670 if(SvROK(SHAREDSvGET(slot))) {
671 shared_sv* target = (shared_sv*) SvIV(SvRV(SHAREDSvGET(slot)));
672 RETVAL = shared_sv_attach_sv(NULL, target);
673 } else {
674 RETVAL = newSVsv(SHAREDSvGET(slot));
675 }
8669ce85
AB
676 Perl_sharedsv_thrcnt_dec(aTHX_ slot);
677 } else {
678 RETVAL = &PL_sv_undef;
679 }
680 SHAREDSvUNLOCK(shared);
681 OUTPUT:
682 RETVAL