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