projects / p5sagit/p5-mst-13.2.git / blame
? search:
summary | shortlog | log | commit | commitdiff | tree
blob | history | HEAD
USE_ENVIRON_ARRAY instead of !MACOS_TRADITIONAL,
[p5sagit/p5-mst-13.2.git] / ext / threads / shared / shared.xs
CommitLineData
b050c948 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 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 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 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 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 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 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 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 98 if(SvROK(sv)) {
99 shared_sv* target = Perl_sharedsv_find(aTHX_ SvRV(sv));
100 if(!target) {
b050c948 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 106 Perl_sv_free(PL_sharedsv_space,SHAREDSvGET(shared));
107 SHAREDSvGET(shared) = newRV_noinc(newSViv((IV)target));
b050c948 108 } else {
f70d29d4 109 SHAREDSvEDIT(shared);
110 sv_setsv(SHAREDSvGET(shared), sv);
b050c948 111 }
55fc11ad 112 shared->index++;
113 mg->mg_private = shared->index;
b050c948 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 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 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 160 shared_sv* shared;
161 if(SvROK(ref))
162 ref = SvRV(ref);
163 shared = Perl_sharedsv_find(aTHX, ref);
b050c948 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 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
6f942b98 194void
195unlock_enabled(ref)
196 SV* ref
197 PROTOTYPE: \$
198 CODE:
199 shared_sv* shared;
200 if(SvROK(ref))
201 ref = SvRV(ref);
202 shared = Perl_sharedsv_find(aTHX, ref);
203 if(!shared)
204 croak("unlock can only be used on shared values");
205 SHAREDSvUNLOCK(shared);
206
207void
208lock_enabled(ref)
209 SV* ref
210 PROTOTYPE: \$
211 CODE:
212 shared_sv* shared;
213 if(SvROK(ref))
214 ref = SvRV(ref);
215 shared = Perl_sharedsv_find(aTHX, ref);
216 if(!shared)
217 croak("lock can only be used on shared values");
218 SHAREDSvLOCK(shared);
219
220
221void
222cond_wait_enabled(ref)
223 SV* ref
224 CODE:
225 shared_sv* shared;
226 int locks;
227 if(SvROK(ref))
228 ref = SvRV(ref);
229 shared = Perl_sharedsv_find(aTHX_ ref);
230 if(!shared)
231 croak("cond_wait can only be used on shared values");
232 if(shared->owner != PERL_GET_CONTEXT)
233 croak("You need a lock before you can cond_wait");
234 MUTEX_LOCK(&shared->mutex);
235 shared->owner = NULL;
236 locks = shared->locks = 0;
237 COND_WAIT(&shared->user_cond, &shared->mutex);
238 shared->owner = PERL_GET_CONTEXT;
239 shared->locks = locks;
240
241void cond_signal_enabled(ref)
242 SV* ref
243 CODE:
244 shared_sv* shared;
245 if(SvROK(ref))
246 ref = SvRV(ref);
247 shared = Perl_sharedsv_find(aTHX_ ref);
248 if(!shared)
249 croak("cond_signal can only be used on shared values");
250 COND_SIGNAL(&shared->user_cond);
251
252
253void cond_broadcast_enabled(ref)
254 SV* ref
255 CODE:
256 shared_sv* shared;
257 if(SvROK(ref))
258 ref = SvRV(ref);
259 shared = Perl_sharedsv_find(aTHX_ ref);
260 if(!shared)
261 croak("cond_broadcast can only be used on shared values");
262 COND_BROADCAST(&shared->user_cond);
b050c948 263
264MODULE = threads::shared PACKAGE = threads::shared::sv
265
266SV*
267new(class, value)
268 SV* class
269 SV* value
270 CODE:
271 shared_sv* shared = Perl_sharedsv_new(aTHX);
272 MAGIC* shared_magic;
273 SV* obj = newSViv((IV)shared);
274 SHAREDSvEDIT(shared);
275 SHAREDSvGET(shared) = newSVsv(value);
276 SHAREDSvRELEASE(shared);
277 sv_magic(value, 0, PERL_MAGIC_ext, "threads::shared", 16);
278 shared_magic = mg_find(value, PERL_MAGIC_ext);
279 shared_magic->mg_virtual = &svtable;
280 shared_magic->mg_obj = newSViv((IV)shared);
281 shared_magic->mg_flags |= MGf_REFCOUNTED;
55fc11ad 282 shared_magic->mg_private = 0;
b050c948 283 SvMAGICAL_on(value);
284 RETVAL = obj;
285 OUTPUT:
286 RETVAL
287
288
aaf3876d 289MODULE = threads::shared PACKAGE = threads::shared::av
290
291SV*
292new(class, value)
293 SV* class
294 SV* value
295 CODE:
296 shared_sv* shared = Perl_sharedsv_new(aTHX);
297 SV* obj = newSViv((IV)shared);
298 SHAREDSvEDIT(shared);
299 SHAREDSvGET(shared) = (SV*) newAV();
300 SHAREDSvRELEASE(shared);
301 RETVAL = obj;
302 OUTPUT:
303 RETVAL
304
305void
306STORE(self, index, value)
307 SV* self
308 SV* index
309 SV* value
310 CODE:
311 shared_sv* shared = (shared_sv*) SvIV(SvRV(self));
312 shared_sv* slot;
313 SV* aentry;
314 SV** aentry_;
79a24c1c 315 if(SvROK(value)) {
316 shared_sv* target = Perl_sharedsv_find(aTHX_ SvRV(value));
317 if(!target) {
318 Perl_croak(aTHX_ "You cannot assign a non shared reference to an shared array");
319 }
320 value = newRV_noinc(newSViv((IV)target));
321 }
aaf3876d 322 SHAREDSvLOCK(shared);
323 aentry_ = av_fetch((AV*) SHAREDSvGET(shared), SvIV(index), 0);
324 if(aentry_ && SvIV((*aentry_))) {
325 aentry = (*aentry_);
326 slot = (shared_sv*) SvIV(aentry);
327 if(SvROK(SHAREDSvGET(slot)))
328 Perl_sharedsv_thrcnt_dec(aTHX_ (shared_sv*) SvIV(SvRV(SHAREDSvGET(slot))));
329 SHAREDSvEDIT(slot);
330 sv_setsv(SHAREDSvGET(slot), value);
331 SHAREDSvRELEASE(slot);
332 } else {
333 slot = Perl_sharedsv_new(aTHX);
334 SHAREDSvEDIT(shared);
335 SHAREDSvGET(slot) = newSVsv(value);
336 aentry = newSViv((IV)slot);
337 av_store((AV*) SHAREDSvGET(shared), SvIV(index), aentry);
338 SHAREDSvRELEASE(shared);
339 }
79a24c1c 340 if(SvROK(SHAREDSvGET(slot)))
341 Perl_sharedsv_thrcnt_inc(aTHX_ (shared_sv*) SvIV(SvRV(SHAREDSvGET(slot))));
342
aaf3876d 343 SHAREDSvUNLOCK(shared);
344
345SV*
346FETCH(self, index)
347 SV* self
348 SV* index
349 CODE:
350 shared_sv* shared = (shared_sv*) SvIV(SvRV(self));
351 shared_sv* slot;
352 SV* aentry;
353 SV** aentry_;
354 SV* retval;
355 SHAREDSvLOCK(shared);
356 aentry_ = av_fetch((AV*) SHAREDSvGET(shared), SvIV(index),0);
357 if(aentry_) {
358 aentry = (*aentry_);
359 if(SvTYPE(aentry) == SVt_NULL) {
360 retval = &PL_sv_undef;
361 } else {
362 slot = (shared_sv*) SvIV(aentry);
79a24c1c 363 if(SvROK(SHAREDSvGET(slot))) {
364 shared_sv* target = (shared_sv*) SvIV(SvRV(SHAREDSvGET(slot)));
365 retval = shared_sv_attach_sv(NULL,target);
366 } else {
367 retval = newSVsv(SHAREDSvGET(slot));
368 }
aaf3876d 369 }
370 } else {
371 retval = &PL_sv_undef;
372 }
373 SHAREDSvUNLOCK(shared);
374 RETVAL = retval;
375 OUTPUT:
376 RETVAL
377
378void
379PUSH(self, ...)
380 SV* self
381 CODE:
382 shared_sv* shared = (shared_sv*) SvIV(SvRV(self));
383 int i;
384 SHAREDSvLOCK(shared);
385 for(i = 1; i < items; i++) {
386 shared_sv* slot = Perl_sharedsv_new(aTHX);
387 SV* tmp = ST(i);
79a24c1c 388 if(SvROK(tmp)) {
389 shared_sv* target = Perl_sharedsv_find(aTHX_ SvRV(tmp));
390 if(!target) {
391 Perl_croak(aTHX_ "You cannot assign a non shared reference to an shared array");
392 }
393 tmp = newRV_noinc(newSViv((IV)target));
394 }
aaf3876d 395 SHAREDSvEDIT(slot);
396 SHAREDSvGET(slot) = newSVsv(tmp);
397 av_push((AV*) SHAREDSvGET(shared), newSViv((IV)slot));
398 SHAREDSvRELEASE(slot);
79a24c1c 399 if(SvROK(SHAREDSvGET(slot)))
400 Perl_sharedsv_thrcnt_inc(aTHX_ (shared_sv*) SvIV(SvRV(SHAREDSvGET(slot))));
aaf3876d 401 }
402 SHAREDSvUNLOCK(shared);
403
404void
405UNSHIFT(self, ...)
406 SV* self
407 CODE:
408 shared_sv* shared = (shared_sv*) SvIV(SvRV(self));
409 int i;
410 SHAREDSvLOCK(shared);
411 SHAREDSvEDIT(shared);
412 av_unshift((AV*)SHAREDSvGET(shared), items - 1);
413 SHAREDSvRELEASE(shared);
414 for(i = 1; i < items; i++) {
415 shared_sv* slot = Perl_sharedsv_new(aTHX);
416 SV* tmp = ST(i);
79a24c1c 417 if(SvROK(tmp)) {
418 shared_sv* target = Perl_sharedsv_find(aTHX_ SvRV(tmp));
419 if(!target) {
420 Perl_croak(aTHX_ "You cannot assign a non shared reference to an shared array");
421 }
422 tmp = newRV_noinc(newSViv((IV)target));
423 }
aaf3876d 424 SHAREDSvEDIT(slot);
425 SHAREDSvGET(slot) = newSVsv(tmp);
426 av_store((AV*) SHAREDSvGET(shared), i - 1, newSViv((IV)slot));
427 SHAREDSvRELEASE(slot);
79a24c1c 428 if(SvROK(SHAREDSvGET(slot)))
429 Perl_sharedsv_thrcnt_inc(aTHX_ (shared_sv*) SvIV(SvRV(SHAREDSvGET(slot))));
aaf3876d 430 }
431 SHAREDSvUNLOCK(shared);
432
433SV*
434POP(self)
435 SV* self
436 CODE:
437 shared_sv* shared = (shared_sv*) SvIV(SvRV(self));
438 shared_sv* slot;
439 SV* retval;
440 SHAREDSvLOCK(shared);
441 SHAREDSvEDIT(shared);
442 retval = av_pop((AV*)SHAREDSvGET(shared));
443 SHAREDSvRELEASE(shared);
444 if(retval && SvIV(retval)) {
445 slot = (shared_sv*) SvIV(retval);
79a24c1c 446 if(SvROK(SHAREDSvGET(slot))) {
447 shared_sv* target = (shared_sv*) SvIV(SvRV(SHAREDSvGET(slot)));
448 retval = shared_sv_attach_sv(NULL,target);
449 } else {
450 retval = newSVsv(SHAREDSvGET(slot));
451 }
aaf3876d 452 Perl_sharedsv_thrcnt_dec(aTHX_ slot);
453 } else {
454 retval = &PL_sv_undef;
455 }
456 SHAREDSvUNLOCK(shared);
457 RETVAL = retval;
458 OUTPUT:
459 RETVAL
460
461
462SV*
463SHIFT(self)
464 SV* self
465 CODE:
466 shared_sv* shared = (shared_sv*) SvIV(SvRV(self));
467 shared_sv* slot;
468 SV* retval;
469 SHAREDSvLOCK(shared);
470 SHAREDSvEDIT(shared);
471 retval = av_shift((AV*)SHAREDSvGET(shared));
472 SHAREDSvRELEASE(shared);
473 if(retval && SvIV(retval)) {
474 slot = (shared_sv*) SvIV(retval);
79a24c1c 475 if(SvROK(SHAREDSvGET(slot))) {
476 shared_sv* target = (shared_sv*) SvIV(SvRV(SHAREDSvGET(slot)));
477 retval = shared_sv_attach_sv(NULL,target);
478 } else {
479 retval = newSVsv(SHAREDSvGET(slot));
480 }
aaf3876d 481 Perl_sharedsv_thrcnt_dec(aTHX_ slot);
482 } else {
483 retval = &PL_sv_undef;
484 }
485 SHAREDSvUNLOCK(shared);
486 RETVAL = retval;
487 OUTPUT:
488 RETVAL
489
490void
491CLEAR(self)
492 SV* self
493 CODE:
494 shared_sv* shared = (shared_sv*) SvIV(SvRV(self));
495 shared_sv* slot;
496 SV** svp;
497 I32 i;
498 SHAREDSvLOCK(shared);
499 svp = AvARRAY((AV*)SHAREDSvGET(shared));
500 i = AvFILLp((AV*)SHAREDSvGET(shared));
501 while ( i >= 0) {
502 if(SvIV(svp[i])) {
503 Perl_sharedsv_thrcnt_dec(aTHX_ (shared_sv*) SvIV(svp[i]));
504 }
505 i--;
506 }
507 SHAREDSvEDIT(shared);
508 av_clear((AV*)SHAREDSvGET(shared));
509 SHAREDSvRELEASE(shared);
510 SHAREDSvUNLOCK(shared);
511
512void
513EXTEND(self, count)
514 SV* self
515 SV* count
516 CODE:
517 shared_sv* shared = (shared_sv*) SvIV(SvRV(self));
518 SHAREDSvEDIT(shared);
519 av_extend((AV*)SHAREDSvGET(shared), (I32) SvIV(count));
520 SHAREDSvRELEASE(shared);
521
522
523
524
525SV*
526EXISTS(self, index)
527 SV* self
528 SV* index
529 CODE:
530 shared_sv* shared = (shared_sv*) SvIV(SvRV(self));
531 I32 exists;
532 SHAREDSvLOCK(shared);
533 exists = av_exists((AV*) SHAREDSvGET(shared), (I32) SvIV(index));
534 if(exists) {
535 RETVAL = &PL_sv_yes;
536 } else {
537 RETVAL = &PL_sv_no;
538 }
539 SHAREDSvUNLOCK(shared);
540
541void
542STORESIZE(self,count)
543 SV* self
544 SV* count
545 CODE:
546 shared_sv* shared = (shared_sv*) SvIV(SvRV(self));
547 SHAREDSvEDIT(shared);
548 av_fill((AV*) SHAREDSvGET(shared), (I32) SvIV(count));
549 SHAREDSvRELEASE(shared);
550
551SV*
552FETCHSIZE(self)
553 SV* self
554 CODE:
555 shared_sv* shared = (shared_sv*) SvIV(SvRV(self));
556 SHAREDSvLOCK(shared);
557 RETVAL = newSViv(av_len((AV*) SHAREDSvGET(shared)) + 1);
558 SHAREDSvUNLOCK(shared);
559 OUTPUT:
560 RETVAL
561
562SV*
563DELETE(self,index)
564 SV* self
565 SV* index
566 CODE:
567 shared_sv* shared = (shared_sv*) SvIV(SvRV(self));
568 shared_sv* slot;
569 SHAREDSvLOCK(shared);
570 if(av_exists((AV*) SHAREDSvGET(shared), (I32) SvIV(index))) {
571 SV* tmp;
572 SHAREDSvEDIT(shared);
573 tmp = av_delete((AV*)SHAREDSvGET(shared), (I32) SvIV(index),0);
574 SHAREDSvRELEASE(shared);
575 if(SvIV(tmp)) {
576 slot = (shared_sv*) SvIV(tmp);
79a24c1c 577 if(SvROK(SHAREDSvGET(slot))) {
578 shared_sv* target = (shared_sv*) SvIV(SvRV(SHAREDSvGET(slot)));
579 RETVAL = shared_sv_attach_sv(NULL,target);
580 } else {
581 RETVAL = newSVsv(SHAREDSvGET(slot));
582 }
aaf3876d 583 Perl_sharedsv_thrcnt_dec(aTHX_ slot);
584 } else {
585 RETVAL = &PL_sv_undef;
586 }
587 } else {
588 RETVAL = &PL_sv_undef;
589 }
590 SHAREDSvUNLOCK(shared);
591 OUTPUT:
592 RETVAL
593
594AV*
595SPLICE(self, offset, length, ...)
596 SV* self
597 SV* offset
598 SV* length
599 CODE:
600 croak("Splice is not implmented for shared arrays");
601
8669ce85 602MODULE = threads::shared PACKAGE = threads::shared::hv
aaf3876d 603
8669ce85 604SV*
605new(class, value)
606 SV* class
607 SV* value
608 CODE:
609 shared_sv* shared = Perl_sharedsv_new(aTHX);
610 SV* obj = newSViv((IV)shared);
611 SHAREDSvEDIT(shared);
612 SHAREDSvGET(shared) = (SV*) newHV();
613 SHAREDSvRELEASE(shared);
614 RETVAL = obj;
615 OUTPUT:
616 RETVAL
617
618void
619STORE(self, key, value)
620 SV* self
621 SV* key
622 SV* value
623 CODE:
624 shared_sv* shared = (shared_sv*) SvIV(SvRV(self));
625 shared_sv* slot;
626 SV* hentry;
627 SV** hentry_;
628 STRLEN len;
629 char* ckey = SvPV(key, len);
409b1fd3 630 SHAREDSvLOCK(shared);
0d76d117 631 if(SvROK(value)) {
632 shared_sv* target = Perl_sharedsv_find(aTHX_ SvRV(value));
633 if(!target) {
634 Perl_croak(aTHX_ "You cannot assign a non shared reference to a shared hash");
635 }
409b1fd3 636 SHAREDSvEDIT(shared);
0d76d117 637 value = newRV_noinc(newSViv((IV)target));
409b1fd3 638 SHAREDSvRELEASE(shared);
0d76d117 639 }
8669ce85 640 hentry_ = hv_fetch((HV*) SHAREDSvGET(shared), ckey, len, 0);
641 if(hentry_ && SvIV((*hentry_))) {
642 hentry = (*hentry_);
643 slot = (shared_sv*) SvIV(hentry);
644 if(SvROK(SHAREDSvGET(slot)))
645 Perl_sharedsv_thrcnt_dec(aTHX_ (shared_sv*) SvIV(SvRV(SHAREDSvGET(slot))));
646 SHAREDSvEDIT(slot);
647 sv_setsv(SHAREDSvGET(slot), value);
648 SHAREDSvRELEASE(slot);
649 } else {
650 slot = Perl_sharedsv_new(aTHX);
651 SHAREDSvEDIT(shared);
652 SHAREDSvGET(slot) = newSVsv(value);
653 hentry = newSViv((IV)slot);
654 hv_store((HV*) SHAREDSvGET(shared), ckey,len , hentry, 0);
655 SHAREDSvRELEASE(shared);
656 }
0d76d117 657 if(SvROK(SHAREDSvGET(slot)))
658 Perl_sharedsv_thrcnt_inc(aTHX_ (shared_sv*) SvIV(SvRV(SHAREDSvGET(slot))));
8669ce85 659 SHAREDSvUNLOCK(shared);
660
661
662SV*
663FETCH(self, key)
664 SV* self
665 SV* key
666 CODE:
667 shared_sv* shared = (shared_sv*) SvIV(SvRV(self));
668 shared_sv* slot;
669 SV* hentry;
670 SV** hentry_;
671 SV* retval;
672 STRLEN len;
673 char* ckey = SvPV(key, len);
674 SHAREDSvLOCK(shared);
675 hentry_ = hv_fetch((HV*) SHAREDSvGET(shared), ckey, len,0);
676 if(hentry_) {
677 hentry = (*hentry_);
678 if(SvTYPE(hentry) == SVt_NULL) {
679 retval = &PL_sv_undef;
680 } else {
681 slot = (shared_sv*) SvIV(hentry);
0d76d117 682 if(SvROK(SHAREDSvGET(slot))) {
683 shared_sv* target = (shared_sv*) SvIV(SvRV(SHAREDSvGET(slot)));
684 retval = shared_sv_attach_sv(NULL, target);
685 } else {
686 retval = newSVsv(SHAREDSvGET(slot));
687 }
8669ce85 688 }
689 } else {
690 retval = &PL_sv_undef;
691 }
692 SHAREDSvUNLOCK(shared);
693 RETVAL = retval;
694 OUTPUT:
695 RETVAL
696
697void
698CLEAR(self)
699 SV* self
700 CODE:
701 shared_sv* shared = (shared_sv*) SvIV(SvRV(self));
702 shared_sv* slot;
703 HE* entry;
704 SHAREDSvLOCK(shared);
705 Perl_hv_iterinit(PL_sharedsv_space, (HV*) SHAREDSvGET(shared));
706 entry = Perl_hv_iternext(PL_sharedsv_space, (HV*) SHAREDSvGET(shared));
707 while(entry) {
708 slot = (shared_sv*) SvIV(Perl_hv_iterval(PL_sharedsv_space, (HV*) SHAREDSvGET(shared), entry));
709 Perl_sharedsv_thrcnt_dec(aTHX_ slot);
710 entry = Perl_hv_iternext(PL_sharedsv_space,(HV*) SHAREDSvGET(shared));
711 }
712 SHAREDSvEDIT(shared);
713 hv_clear((HV*) SHAREDSvGET(shared));
714 SHAREDSvRELEASE(shared);
715 SHAREDSvUNLOCK(shared);
716
717SV*
718FIRSTKEY(self)
719 SV* self
720 CODE:
721 shared_sv* shared = (shared_sv*) SvIV(SvRV(self));
722 char* key = NULL;
723 I32 len;
724 HE* entry;
725 SHAREDSvLOCK(shared);
726 Perl_hv_iterinit(PL_sharedsv_space, (HV*) SHAREDSvGET(shared));
727 entry = Perl_hv_iternext(PL_sharedsv_space, (HV*) SHAREDSvGET(shared));
728 if(entry) {
729 key = Perl_hv_iterkey(PL_sharedsv_space, entry,&len);
730 RETVAL = newSVpv(key, len);
731 } else {
732 RETVAL = &PL_sv_undef;
733 }
734 SHAREDSvUNLOCK(shared);
735 OUTPUT:
736 RETVAL
737
738
739SV*
740NEXTKEY(self, oldkey)
741 SV* self
742 SV* oldkey
743 CODE:
744 shared_sv* shared = (shared_sv*) SvIV(SvRV(self));
745 char* key = NULL;
746 I32 len;
747 HE* entry;
748 SHAREDSvLOCK(shared);
749 entry = Perl_hv_iternext(PL_sharedsv_space, (HV*) SHAREDSvGET(shared));
750 if(entry) {
751 key = Perl_hv_iterkey(PL_sharedsv_space, entry,&len);
752 RETVAL = newSVpv(key, len);
753 } else {
754 RETVAL = &PL_sv_undef;
755 }
756 SHAREDSvUNLOCK(shared);
757 OUTPUT:
758 RETVAL
759
760
761SV*
762EXISTS(self, key)
763 SV* self
764 SV* key
765 CODE:
766 shared_sv* shared = (shared_sv*) SvIV(SvRV(self));
767 STRLEN len;
768 char* ckey = SvPV(key, len);
769 SHAREDSvLOCK(shared);
770 if(hv_exists((HV*)SHAREDSvGET(shared), ckey, len)) {
771 RETVAL = &PL_sv_yes;
772 } else {
773 RETVAL = &PL_sv_no;
774 }
775 SHAREDSvUNLOCK(shared);
776 OUTPUT:
777 RETVAL
778
779SV*
780DELETE(self, key)
781 SV* self
782 SV* key
783 CODE:
784 shared_sv* shared = (shared_sv*) SvIV(SvRV(self));
785 shared_sv* slot;
786 STRLEN len;
787 char* ckey = SvPV(key, len);
788 SV* tmp;
789 SHAREDSvLOCK(shared);
790 SHAREDSvEDIT(shared);
791 tmp = hv_delete((HV*) SHAREDSvGET(shared), ckey, len,0);
792 SHAREDSvRELEASE(shared);
793 if(tmp) {
b48e3745 794 slot = (shared_sv*) SvIV(tmp);
0d76d117 795 if(SvROK(SHAREDSvGET(slot))) {
796 shared_sv* target = (shared_sv*) SvIV(SvRV(SHAREDSvGET(slot)));
797 RETVAL = shared_sv_attach_sv(NULL, target);
798 } else {
799 RETVAL = newSVsv(SHAREDSvGET(slot));
800 }
8669ce85 801 Perl_sharedsv_thrcnt_dec(aTHX_ slot);
802 } else {
803 RETVAL = &PL_sv_undef;
804 }
805 SHAREDSvUNLOCK(shared);
806 OUTPUT:
807 RETVAL
Unnamed repository; edit this file to name it for gitweb.