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