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