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


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


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