[p5sagit/p5-mst-13.2.git] / ext / threads / shared / shared.xs


#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"

MGVTBL svtable;

SV* shared_sv_attach_sv (SV* sv, shared_sv* shared) {
    HV* shared_hv = get_hv("threads::shared::shared", FALSE);
    SV* id = newSViv((IV)shared);
    STRLEN length = sv_len(id);
    SV* tiedobject;
    SV** tiedobject_ = hv_fetch(shared_hv, SvPV(id,length), length, 0);
    if(tiedobject_) {
    	tiedobject = (*tiedobject_);
	if(sv) {
            SvROK_on(sv);
            SvRV(sv) = SvRV(tiedobject);
	} else {
	    sv = newRV(SvRV(tiedobject));
	}
    } else {
	switch(SvTYPE(SHAREDSvGET(shared))) {
	    default: {
	        MAGIC* shared_magic;
		SV* value = newSVsv(SHAREDSvGET(shared));
	        SV* obj = newSViv((IV)shared);
        	sv_magic(value, 0, PERL_MAGIC_ext, "threads::shared", 16);
        	shared_magic = mg_find(value, PERL_MAGIC_ext);
        	shared_magic->mg_virtual = &svtable;
        	shared_magic->mg_obj = newSViv((IV)shared);
        	shared_magic->mg_flags |= MGf_REFCOUNTED;
        	shared_magic->mg_private = 0;
        	SvMAGICAL_on(value);
	        sv = newRV_noinc(value);
	        value = newRV(value);
 		sv_rvweaken(value);
	        hv_store(shared_hv, SvPV(id,length),length, value, 0);
		Perl_sharedsv_thrcnt_inc(aTHX_ shared);
	    }
	    	
	}
    }
    return sv;
}


int shared_sv_fetch_mg (pTHX_ SV* sv, MAGIC *mg) {
    shared_sv* shared = (shared_sv*) SvIV(mg->mg_obj);
    SHAREDSvLOCK(shared);
    if(mg->mg_private != shared->index) {
        if(SvROK(SHAREDSvGET(shared))) {
            shared_sv* target = (shared_sv*) SvIV(SvRV(SHAREDSvGET(shared)));
	    shared_sv_attach_sv(sv, target);
        } else {
            sv_setsv(sv, SHAREDSvGET(shared));
        }
        mg->mg_private = shared->index;
    }
    SHAREDSvUNLOCK(shared);

    return 0;
}

int shared_sv_store_mg (pTHX_ SV* sv, MAGIC *mg) {
    shared_sv* shared = (shared_sv*) SvIV(mg->mg_obj);
    SHAREDSvLOCK(shared);
    if(SvROK(SHAREDSvGET(shared)))
        Perl_sharedsv_thrcnt_dec(aTHX_ (shared_sv*) SvIV(SvRV(SHAREDSvGET(shared))));
    if(SvROK(sv)) {
        shared_sv* target = Perl_sharedsv_find(aTHX_ SvRV(sv));
        if(!target) {
            sv_setsv(sv,SHAREDSvGET(shared));
            SHAREDSvUNLOCK(shared);            
            Perl_croak(aTHX_ "You cannot assign a non shared reference to a shared scalar");
        }
        SHAREDSvEDIT(shared);
        Perl_sv_free(PL_sharedsv_space,SHAREDSvGET(shared));
        SHAREDSvGET(shared) = newRV_noinc(newSViv((IV)target));
    } else {
            SHAREDSvEDIT(shared);
	sv_setsv(SHAREDSvGET(shared), sv);
    }
    shared->index++;
    mg->mg_private = shared->index;
    SHAREDSvRELEASE(shared);
    if(SvROK(SHAREDSvGET(shared)))
       Perl_sharedsv_thrcnt_inc(aTHX_ (shared_sv*) SvIV(SvRV(SHAREDSvGET(shared))));       
    SHAREDSvUNLOCK(shared);
    return 0;
}

int shared_sv_destroy_mg (pTHX_ SV* sv, MAGIC *mg) {
    shared_sv* shared = (shared_sv*) SvIV(mg->mg_obj);
    if(!shared) 
        return 0;
    {
	HV* shared_hv = get_hv("threads::shared::shared", FALSE);
        SV* id = newSViv((IV)shared);
        STRLEN length = sv_len(id);
        hv_delete(shared_hv, SvPV(id,length), length,0);
    }
    Perl_sharedsv_thrcnt_dec(aTHX_ shared);
}

MGVTBL svtable = {MEMBER_TO_FPTR(shared_sv_fetch_mg),
		  MEMBER_TO_FPTR(shared_sv_store_mg),
		  0,
		  0,
		  MEMBER_TO_FPTR(shared_sv_destroy_mg)
};

MODULE = threads::shared		PACKAGE = threads::shared		


PROTOTYPES: DISABLE


SV*
ptr(ref)
	SV* ref
	CODE:
	RETVAL = newSViv(SvIV(SvRV(ref)));
	OUTPUT:
	RETVAL


SV*
_thrcnt(ref)
        SV* ref
	CODE:
        shared_sv* shared;
	if(SvROK(ref))
	    ref = SvRV(ref);
	shared = Perl_sharedsv_find(aTHX, ref);
        if(!shared)
           croak("thrcnt can only be used on shared values");
	SHAREDSvLOCK(shared);
        RETVAL = newSViv(SvREFCNT(SHAREDSvGET(shared)));
        SHAREDSvUNLOCK(shared);
	OUTPUT:
        RETVAL   


void
thrcnt_inc(ref)
        SV* ref
        CODE:
	shared_sv* shared;
        if(SvROK(ref)) 
            ref = SvRV(ref);
        shared = Perl_sharedsv_find(aTHX, ref);
        if(!shared)
           croak("thrcnt can only be used on shared values");
	Perl_sharedsv_thrcnt_inc(aTHX_ shared);

void
_thrcnt_dec(ref)
        SV* ref
        CODE:
	shared_sv* shared = (shared_sv*) SvIV(ref);
        if(!shared)
           croak("thrcnt can only be used on shared values");
	Perl_sharedsv_thrcnt_dec(aTHX_ shared);


MODULE = threads::shared		PACKAGE = threads::shared::sv		

SV*
new(class, value)
	SV* class
	SV* value
	CODE:
	shared_sv* shared = Perl_sharedsv_new(aTHX);
        MAGIC* shared_magic;
	SV* obj = newSViv((IV)shared);
	SHAREDSvEDIT(shared);
	SHAREDSvGET(shared) = newSVsv(value);
        SHAREDSvRELEASE(shared);
	sv_magic(value, 0, PERL_MAGIC_ext, "threads::shared", 16);
        shared_magic = mg_find(value, PERL_MAGIC_ext);
        shared_magic->mg_virtual = &svtable;
        shared_magic->mg_obj = newSViv((IV)shared);
        shared_magic->mg_flags |= MGf_REFCOUNTED;
        shared_magic->mg_private = 0;
        SvMAGICAL_on(value);
        RETVAL = obj;
        OUTPUT:        	
        RETVAL


MODULE = threads::shared		PACKAGE = threads::shared::av

SV* 
new(class, value)
	SV* class
	SV* value
	CODE:
	shared_sv* shared = Perl_sharedsv_new(aTHX);
	SV* obj = newSViv((IV)shared);
        SHAREDSvEDIT(shared);
        SHAREDSvGET(shared) = (SV*) newAV();
        SHAREDSvRELEASE(shared);
        RETVAL = obj;
        OUTPUT:
        RETVAL

void
STORE(self, index, value)
        SV* self
	SV* index
        SV* value
        CODE:    
        shared_sv* shared = (shared_sv*) SvIV(SvRV(self));
        shared_sv* slot;
        SV* aentry;
	SV** aentry_;
	if(SvROK(value)) {
	    shared_sv* target = Perl_sharedsv_find(aTHX_ SvRV(value));
	    if(!target) {
	         Perl_croak(aTHX_ "You cannot assign a non shared reference to an shared array");
	    }
            value = newRV_noinc(newSViv((IV)target));
        }
	SHAREDSvLOCK(shared);
	aentry_ = av_fetch((AV*) SHAREDSvGET(shared), SvIV(index), 0);
	if(aentry_ && SvIV((*aentry_))) {
	    aentry = (*aentry_);
            slot = (shared_sv*) SvIV(aentry);
            if(SvROK(SHAREDSvGET(slot)))
                Perl_sharedsv_thrcnt_dec(aTHX_ (shared_sv*) SvIV(SvRV(SHAREDSvGET(slot))));
            SHAREDSvEDIT(slot);
            sv_setsv(SHAREDSvGET(slot), value);
            SHAREDSvRELEASE(slot);
	} else {
            slot = Perl_sharedsv_new(aTHX);
            SHAREDSvEDIT(shared);
            SHAREDSvGET(slot) = newSVsv(value);
            aentry = newSViv((IV)slot);
            av_store((AV*) SHAREDSvGET(shared), SvIV(index), aentry);
            SHAREDSvRELEASE(shared);
	}
        if(SvROK(SHAREDSvGET(slot)))
            Perl_sharedsv_thrcnt_inc(aTHX_ (shared_sv*) SvIV(SvRV(SHAREDSvGET(slot))));

        SHAREDSvUNLOCK(shared);

SV*
FETCH(self, index)
        SV* self
	SV* index
	CODE:
	shared_sv* shared = (shared_sv*) SvIV(SvRV(self));
	shared_sv* slot;
	SV* aentry;
	SV** aentry_;
	SV* retval;
	SHAREDSvLOCK(shared);
 	aentry_ = av_fetch((AV*) SHAREDSvGET(shared), SvIV(index),0);
	if(aentry_) {
	    aentry = (*aentry_);
            if(SvTYPE(aentry) == SVt_NULL) {
	        retval = &PL_sv_undef;
	    } else {
	        slot = (shared_sv*) SvIV(aentry);
		if(SvROK(SHAREDSvGET(slot))) {
		     shared_sv* target = (shared_sv*) SvIV(SvRV(SHAREDSvGET(slot)));
		     retval = shared_sv_attach_sv(NULL,target);
		} else {
	             retval = newSVsv(SHAREDSvGET(slot));
		}
            }
	} else {
	    retval = &PL_sv_undef;
	}
        SHAREDSvUNLOCK(shared);	
        RETVAL = retval;
        OUTPUT:
        RETVAL

void
PUSH(self, ...)
	SV* self
	CODE:
	shared_sv* shared = (shared_sv*) SvIV(SvRV(self));
        int i;
        SHAREDSvLOCK(shared);
	for(i = 1; i < items; i++) {
    	    shared_sv* slot = Perl_sharedsv_new(aTHX);
	    SV* tmp = ST(i);
	    if(SvROK(tmp)) {
                 shared_sv* target = Perl_sharedsv_find(aTHX_ SvRV(tmp));
                 if(!target) {
                     Perl_croak(aTHX_ "You cannot assign a non shared reference to an shared array");
                 }
                 tmp = newRV_noinc(newSViv((IV)target));
            }
            SHAREDSvEDIT(slot);
	    SHAREDSvGET(slot) = newSVsv(tmp);
	    av_push((AV*) SHAREDSvGET(shared), newSViv((IV)slot));	    
	    SHAREDSvRELEASE(slot);
	    if(SvROK(SHAREDSvGET(slot)))
                Perl_sharedsv_thrcnt_inc(aTHX_ (shared_sv*) SvIV(SvRV(SHAREDSvGET(slot))));
	}
        SHAREDSvUNLOCK(shared);

void
UNSHIFT(self, ...)
	SV* self
	CODE:
	shared_sv* shared = (shared_sv*) SvIV(SvRV(self));
        int i;
        SHAREDSvLOCK(shared);
	SHAREDSvEDIT(shared);
	av_unshift((AV*)SHAREDSvGET(shared), items - 1);
	SHAREDSvRELEASE(shared);
	for(i = 1; i < items; i++) {
    	    shared_sv* slot = Perl_sharedsv_new(aTHX);
	    SV* tmp = ST(i);
	    if(SvROK(tmp)) {
                 shared_sv* target = Perl_sharedsv_find(aTHX_ SvRV(tmp));
                 if(!target) {
                     Perl_croak(aTHX_ "You cannot assign a non shared reference to an shared array");
                 }
                 tmp = newRV_noinc(newSViv((IV)target));
            }
            SHAREDSvEDIT(slot);
	    SHAREDSvGET(slot) = newSVsv(tmp);
	    av_store((AV*) SHAREDSvGET(shared), i - 1, newSViv((IV)slot));
	    SHAREDSvRELEASE(slot);
	    if(SvROK(SHAREDSvGET(slot)))
                Perl_sharedsv_thrcnt_inc(aTHX_ (shared_sv*) SvIV(SvRV(SHAREDSvGET(slot))));
	}
        SHAREDSvUNLOCK(shared);

SV*
POP(self)
	SV* self
	CODE:
	shared_sv* shared = (shared_sv*) SvIV(SvRV(self));
	shared_sv* slot;
	SV* retval;
	SHAREDSvLOCK(shared);
	SHAREDSvEDIT(shared);
	retval = av_pop((AV*)SHAREDSvGET(shared));
	SHAREDSvRELEASE(shared);
	if(retval && SvIV(retval)) {
	    slot = (shared_sv*) SvIV(retval);
	    if(SvROK(SHAREDSvGET(slot))) {
		 shared_sv* target = (shared_sv*) SvIV(SvRV(SHAREDSvGET(slot)));
		 retval = shared_sv_attach_sv(NULL,target);
	    } else {
	         retval = newSVsv(SHAREDSvGET(slot));
            }
            Perl_sharedsv_thrcnt_dec(aTHX_ slot);
	} else {
            retval = &PL_sv_undef;
	}
	SHAREDSvUNLOCK(shared);
	RETVAL = retval;
	OUTPUT:
	RETVAL


SV*
SHIFT(self)
	SV* self
	CODE:
	shared_sv* shared = (shared_sv*) SvIV(SvRV(self));
	shared_sv* slot;
	SV* retval;
	SHAREDSvLOCK(shared);
	SHAREDSvEDIT(shared);
	retval = av_shift((AV*)SHAREDSvGET(shared));
	SHAREDSvRELEASE(shared);
	if(retval && SvIV(retval)) {
	    slot = (shared_sv*) SvIV(retval);
            if(SvROK(SHAREDSvGET(slot))) {
                 shared_sv* target = (shared_sv*) SvIV(SvRV(SHAREDSvGET(slot)));
                 retval = shared_sv_attach_sv(NULL,target);
            } else {
                 retval = newSVsv(SHAREDSvGET(slot));
            }
            Perl_sharedsv_thrcnt_dec(aTHX_ slot);
	} else {
            retval = &PL_sv_undef;
	}
	SHAREDSvUNLOCK(shared);
	RETVAL = retval;
	OUTPUT:
	RETVAL

void
CLEAR(self)
	SV* self
	CODE:
	shared_sv* shared = (shared_sv*) SvIV(SvRV(self));
	shared_sv* slot;
	SV** svp;
	I32 i;
	SHAREDSvLOCK(shared);
	svp = AvARRAY((AV*)SHAREDSvGET(shared));
	i   = AvFILLp((AV*)SHAREDSvGET(shared));
	while ( i >= 0) {
	    if(SvIV(svp[i])) {
	        Perl_sharedsv_thrcnt_dec(aTHX_ (shared_sv*) SvIV(svp[i]));
	    }
	    i--;
	}
	SHAREDSvEDIT(shared);
	av_clear((AV*)SHAREDSvGET(shared));
	SHAREDSvRELEASE(shared);
	SHAREDSvUNLOCK(shared);
	
void
EXTEND(self, count)
	SV* self
	SV* count
	CODE:
	shared_sv* shared = (shared_sv*) SvIV(SvRV(self));
	SHAREDSvEDIT(shared);
	av_extend((AV*)SHAREDSvGET(shared), (I32) SvIV(count));
	SHAREDSvRELEASE(shared);


SV*
EXISTS(self, index)
	SV* self
	SV* index
	CODE:
	shared_sv* shared = (shared_sv*) SvIV(SvRV(self));
	I32 exists;
	SHAREDSvLOCK(shared);
	exists = av_exists((AV*) SHAREDSvGET(shared), (I32) SvIV(index));
	if(exists) {
	    RETVAL = &PL_sv_yes;
	} else {
	    RETVAL = &PL_sv_no;
	}
	SHAREDSvUNLOCK(shared);

void
STORESIZE(self,count)
	SV* self
	SV* count
	CODE:
	shared_sv* shared = (shared_sv*) SvIV(SvRV(self));
	SHAREDSvEDIT(shared);
	av_fill((AV*) SHAREDSvGET(shared), (I32) SvIV(count));
	SHAREDSvRELEASE(shared);

SV*
FETCHSIZE(self)
	SV* self
	CODE:
	shared_sv* shared = (shared_sv*) SvIV(SvRV(self));
	SHAREDSvLOCK(shared);
	RETVAL = newSViv(av_len((AV*) SHAREDSvGET(shared)) + 1);
	SHAREDSvUNLOCK(shared);
	OUTPUT:
	RETVAL

SV*
DELETE(self,index)
	SV* self
	SV* index
	CODE:
	shared_sv* shared = (shared_sv*) SvIV(SvRV(self));
	shared_sv* slot;
	SHAREDSvLOCK(shared);
	if(av_exists((AV*) SHAREDSvGET(shared), (I32) SvIV(index))) {
	    SV* tmp;
	    SHAREDSvEDIT(shared);
	    tmp = av_delete((AV*)SHAREDSvGET(shared), (I32) SvIV(index),0);
	    SHAREDSvRELEASE(shared);
	    if(SvIV(tmp)) {
		slot = (shared_sv*) SvIV(tmp);
                if(SvROK(SHAREDSvGET(slot))) {
                   shared_sv* target = (shared_sv*) SvIV(SvRV(SHAREDSvGET(slot)));
                   RETVAL = shared_sv_attach_sv(NULL,target);
                } else {
                   RETVAL = newSVsv(SHAREDSvGET(slot));
                }
                Perl_sharedsv_thrcnt_dec(aTHX_ slot);               
	    } else {
                RETVAL = &PL_sv_undef;
	    }	    
	} else {
	    RETVAL = &PL_sv_undef;
	}	
	SHAREDSvUNLOCK(shared);
	OUTPUT:
	RETVAL

AV*
SPLICE(self, offset, length, ...)
	SV* self
	SV* offset
	SV* length
	CODE:
	croak("Splice is not implmented for shared arrays");
	
MODULE = threads::shared		PACKAGE = threads::shared::hv

SV* 
new(class, value)
	SV* class
	SV* value
	CODE:
	shared_sv* shared = Perl_sharedsv_new(aTHX);
	SV* obj = newSViv((IV)shared);
        SHAREDSvEDIT(shared);
        SHAREDSvGET(shared) = (SV*) newHV();
        SHAREDSvRELEASE(shared);
        RETVAL = obj;
        OUTPUT:
        RETVAL

void
STORE(self, key, value)
        SV* self
        SV* key
        SV* value
        CODE:
        shared_sv* shared = (shared_sv*) SvIV(SvRV(self));
        shared_sv* slot;
        SV* hentry;
        SV** hentry_;
	STRLEN len;
	char* ckey = SvPV(key, len);
        SHAREDSvLOCK(shared);
	if(SvROK(value)) {
	    shared_sv* target = Perl_sharedsv_find(aTHX_ SvRV(value));
	    if(!target) {
		Perl_croak(aTHX_ "You cannot assign a non shared reference to a shared hash");
            }
	    SHAREDSvEDIT(shared);
	    value = newRV_noinc(newSViv((IV)target));
	    SHAREDSvRELEASE(shared);
	}
        hentry_ = hv_fetch((HV*) SHAREDSvGET(shared), ckey, len, 0);
        if(hentry_ && SvIV((*hentry_))) {
            hentry = (*hentry_);
            slot = (shared_sv*) SvIV(hentry);
            if(SvROK(SHAREDSvGET(slot)))
                Perl_sharedsv_thrcnt_dec(aTHX_ (shared_sv*) SvIV(SvRV(SHAREDSvGET(slot))));
            SHAREDSvEDIT(slot);
            sv_setsv(SHAREDSvGET(slot), value);
            SHAREDSvRELEASE(slot);
        } else {
            slot = Perl_sharedsv_new(aTHX);
            SHAREDSvEDIT(shared);
            SHAREDSvGET(slot) = newSVsv(value);
            hentry = newSViv((IV)slot);
            hv_store((HV*) SHAREDSvGET(shared), ckey,len , hentry, 0);
            SHAREDSvRELEASE(shared);
        }
	if(SvROK(SHAREDSvGET(slot)))
	    Perl_sharedsv_thrcnt_inc(aTHX_ (shared_sv*) SvIV(SvRV(SHAREDSvGET(slot))));
        SHAREDSvUNLOCK(shared);


SV*
FETCH(self, key)
        SV* self
        SV* key
        CODE:
        shared_sv* shared = (shared_sv*) SvIV(SvRV(self));
        shared_sv* slot;
        SV* hentry;
        SV** hentry_;
        SV* retval;
	STRLEN len;
	char* ckey = SvPV(key, len);
        SHAREDSvLOCK(shared);
        hentry_ = hv_fetch((HV*) SHAREDSvGET(shared), ckey, len,0);
        if(hentry_) {
            hentry = (*hentry_);
            if(SvTYPE(hentry) == SVt_NULL) {
                retval = &PL_sv_undef;
            } else {
                slot = (shared_sv*) SvIV(hentry);
		if(SvROK(SHAREDSvGET(slot))) {
		    shared_sv* target = (shared_sv*) SvIV(SvRV(SHAREDSvGET(slot)));
		    retval = shared_sv_attach_sv(NULL, target);
		} else {
	            retval = newSVsv(SHAREDSvGET(slot));
		}
            }
        } else {
            retval = &PL_sv_undef;
        }
        SHAREDSvUNLOCK(shared);
        RETVAL = retval;
        OUTPUT:
        RETVAL

void
CLEAR(self)
	SV* self
	CODE:
        shared_sv* shared = (shared_sv*) SvIV(SvRV(self));
        shared_sv* slot;
	HE* entry;
	SHAREDSvLOCK(shared);
	Perl_hv_iterinit(PL_sharedsv_space, (HV*) SHAREDSvGET(shared));
	entry = Perl_hv_iternext(PL_sharedsv_space, (HV*) SHAREDSvGET(shared));
	while(entry) {
		slot = (shared_sv*) SvIV(Perl_hv_iterval(PL_sharedsv_space, (HV*) SHAREDSvGET(shared), entry));
		Perl_sharedsv_thrcnt_dec(aTHX_ slot);
		entry = Perl_hv_iternext(PL_sharedsv_space,(HV*) SHAREDSvGET(shared));
	}
	SHAREDSvEDIT(shared);
	hv_clear((HV*) SHAREDSvGET(shared));
	SHAREDSvRELEASE(shared);
	SHAREDSvUNLOCK(shared);

SV*
FIRSTKEY(self)
	SV* self
	CODE:
        shared_sv* shared = (shared_sv*) SvIV(SvRV(self));
	char* key = NULL;
	I32 len;
	HE* entry;
	SHAREDSvLOCK(shared);
        Perl_hv_iterinit(PL_sharedsv_space, (HV*) SHAREDSvGET(shared));
        entry = Perl_hv_iternext(PL_sharedsv_space, (HV*) SHAREDSvGET(shared));
	if(entry) {
                key = Perl_hv_iterkey(PL_sharedsv_space, entry,&len);
		RETVAL = newSVpv(key, len);
        } else {
	     RETVAL = &PL_sv_undef;
	}
        SHAREDSvUNLOCK(shared);
	OUTPUT:
	RETVAL


SV*
NEXTKEY(self, oldkey)
        SV* self
	SV* oldkey
        CODE:
        shared_sv* shared = (shared_sv*) SvIV(SvRV(self));
        char* key = NULL;
        I32 len;
        HE* entry;
        SHAREDSvLOCK(shared);
        entry = Perl_hv_iternext(PL_sharedsv_space, (HV*) SHAREDSvGET(shared));
        if(entry) {
                key = Perl_hv_iterkey(PL_sharedsv_space, entry,&len);
                RETVAL = newSVpv(key, len);
        } else {
             RETVAL = &PL_sv_undef;
        }
        SHAREDSvUNLOCK(shared);
        OUTPUT:
        RETVAL


SV*
EXISTS(self, key)
	SV* self
	SV* key
	CODE:
	shared_sv* shared = (shared_sv*) SvIV(SvRV(self));
	STRLEN len;
	char* ckey = SvPV(key, len);
	SHAREDSvLOCK(shared);
	if(hv_exists((HV*)SHAREDSvGET(shared), ckey, len)) {
		RETVAL = &PL_sv_yes;
	} else {
		RETVAL = &PL_sv_no;
	}
	SHAREDSvUNLOCK(shared);
	OUTPUT:
	RETVAL

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