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