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


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


void 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_);
        SvROK_on(sv);
        SvRV(sv) = SvRV(tiedobject);

    } else {
        croak("die\n");
    }
}


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 = 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);


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